{-# LANGUAGE DeriveFunctor #-}
module Text.Parse.Stupid
  ( Sexpr(..)
  , parse
  , hydrateSpaces
  , print
  ) where

import Prelude hiding (print)

import Data.Bifunctor (first)

data Sexpr a = Atom a | Combo String [Sexpr a]
  deriving (Sexpr a -> Sexpr a -> Bool
(Sexpr a -> Sexpr a -> Bool)
-> (Sexpr a -> Sexpr a -> Bool) -> Eq (Sexpr a)
forall a. Eq a => Sexpr a -> Sexpr a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sexpr a -> Sexpr a -> Bool
$c/= :: forall a. Eq a => Sexpr a -> Sexpr a -> Bool
== :: Sexpr a -> Sexpr a -> Bool
$c== :: forall a. Eq a => Sexpr a -> Sexpr a -> Bool
Eq, Eq (Sexpr a)
Eq (Sexpr a)
-> (Sexpr a -> Sexpr a -> Ordering)
-> (Sexpr a -> Sexpr a -> Bool)
-> (Sexpr a -> Sexpr a -> Bool)
-> (Sexpr a -> Sexpr a -> Bool)
-> (Sexpr a -> Sexpr a -> Bool)
-> (Sexpr a -> Sexpr a -> Sexpr a)
-> (Sexpr a -> Sexpr a -> Sexpr a)
-> Ord (Sexpr a)
Sexpr a -> Sexpr a -> Bool
Sexpr a -> Sexpr a -> Ordering
Sexpr a -> Sexpr a -> Sexpr a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Sexpr a)
forall a. Ord a => Sexpr a -> Sexpr a -> Bool
forall a. Ord a => Sexpr a -> Sexpr a -> Ordering
forall a. Ord a => Sexpr a -> Sexpr a -> Sexpr a
min :: Sexpr a -> Sexpr a -> Sexpr a
$cmin :: forall a. Ord a => Sexpr a -> Sexpr a -> Sexpr a
max :: Sexpr a -> Sexpr a -> Sexpr a
$cmax :: forall a. Ord a => Sexpr a -> Sexpr a -> Sexpr a
>= :: Sexpr a -> Sexpr a -> Bool
$c>= :: forall a. Ord a => Sexpr a -> Sexpr a -> Bool
> :: Sexpr a -> Sexpr a -> Bool
$c> :: forall a. Ord a => Sexpr a -> Sexpr a -> Bool
<= :: Sexpr a -> Sexpr a -> Bool
$c<= :: forall a. Ord a => Sexpr a -> Sexpr a -> Bool
< :: Sexpr a -> Sexpr a -> Bool
$c< :: forall a. Ord a => Sexpr a -> Sexpr a -> Bool
compare :: Sexpr a -> Sexpr a -> Ordering
$ccompare :: forall a. Ord a => Sexpr a -> Sexpr a -> Ordering
Ord, Int -> Sexpr a -> ShowS
[Sexpr a] -> ShowS
Sexpr a -> String
(Int -> Sexpr a -> ShowS)
-> (Sexpr a -> String) -> ([Sexpr a] -> ShowS) -> Show (Sexpr a)
forall a. Show a => Int -> Sexpr a -> ShowS
forall a. Show a => [Sexpr a] -> ShowS
forall a. Show a => Sexpr a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sexpr a] -> ShowS
$cshowList :: forall a. Show a => [Sexpr a] -> ShowS
show :: Sexpr a -> String
$cshow :: forall a. Show a => Sexpr a -> String
showsPrec :: Int -> Sexpr a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Sexpr a -> ShowS
Show, ReadPrec [Sexpr a]
ReadPrec (Sexpr a)
Int -> ReadS (Sexpr a)
ReadS [Sexpr a]
(Int -> ReadS (Sexpr a))
-> ReadS [Sexpr a]
-> ReadPrec (Sexpr a)
-> ReadPrec [Sexpr a]
-> Read (Sexpr a)
forall a. Read a => ReadPrec [Sexpr a]
forall a. Read a => ReadPrec (Sexpr a)
forall a. Read a => Int -> ReadS (Sexpr a)
forall a. Read a => ReadS [Sexpr a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Sexpr a]
$creadListPrec :: forall a. Read a => ReadPrec [Sexpr a]
readPrec :: ReadPrec (Sexpr a)
$creadPrec :: forall a. Read a => ReadPrec (Sexpr a)
readList :: ReadS [Sexpr a]
$creadList :: forall a. Read a => ReadS [Sexpr a]
readsPrec :: Int -> ReadS (Sexpr a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Sexpr a)
Read, (forall a b. (a -> b) -> Sexpr a -> Sexpr b)
-> (forall a b. a -> Sexpr b -> Sexpr a) -> Functor Sexpr
forall a b. a -> Sexpr b -> Sexpr a
forall a b. (a -> b) -> Sexpr a -> Sexpr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Sexpr b -> Sexpr a
$c<$ :: forall a b. a -> Sexpr b -> Sexpr a
fmap :: forall a b. (a -> b) -> Sexpr a -> Sexpr b
$cfmap :: forall a b. (a -> b) -> Sexpr a -> Sexpr b
Functor)

brackPairs :: [(String, String)]
brackPairs :: [(String, String)]
brackPairs =
  [ ( String
"("  , String
")" )
  , ( String
"$(" , String
")" )
  , ( String
"["  , String
"]" )
  , ( String
"{"  , String
"}" )
  ]

parse :: String -> Maybe [Sexpr String]
parse :: String -> Maybe [Sexpr String]
parse = (([Sexpr String], [String]) -> [Sexpr String])
-> Maybe ([Sexpr String], [String]) -> Maybe [Sexpr String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Sexpr String], [String]) -> [Sexpr String]
forall a b. (a, b) -> a
fst (Maybe ([Sexpr String], [String]) -> Maybe [Sexpr String])
-> (String -> Maybe ([Sexpr String], [String]))
-> String
-> Maybe [Sexpr String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Maybe ([Sexpr String], [String])
go ([String] -> Maybe ([Sexpr String], [String]))
-> (String -> [String])
-> String
-> Maybe ([Sexpr String], [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
tokenize
  where
  go :: [String] -> Maybe ([Sexpr String], [String])
  go :: [String] -> Maybe ([Sexpr String], [String])
go [] = ([Sexpr String], [String]) -> Maybe ([Sexpr String], [String])
forall a. a -> Maybe a
Just ([], [])
  go (String
t:[String]
ts) = case String
t of
    String
close | String
close String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((String, String) -> String) -> [(String, String)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, String) -> String
forall a b. (a, b) -> b
snd [(String, String)]
brackPairs -> ([Sexpr String], [String]) -> Maybe ([Sexpr String], [String])
forall a. a -> Maybe a
Just ([], String
tString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ts)
    String
open | Just String
close <- String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
open [(String, String)]
brackPairs -> do
      ([Sexpr String]
inner, [String]
rest) <- [String] -> Maybe ([Sexpr String], [String])
go [String]
ts
      case [String]
rest of
        String
t':[String]
rest' | String
t' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
close -> ((([Sexpr String], [String]) -> ([Sexpr String], [String]))
-> Maybe ([Sexpr String], [String])
-> Maybe ([Sexpr String], [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((([Sexpr String], [String]) -> ([Sexpr String], [String]))
 -> Maybe ([Sexpr String], [String])
 -> Maybe ([Sexpr String], [String]))
-> (([Sexpr String] -> [Sexpr String])
    -> ([Sexpr String], [String]) -> ([Sexpr String], [String]))
-> ([Sexpr String] -> [Sexpr String])
-> Maybe ([Sexpr String], [String])
-> Maybe ([Sexpr String], [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Sexpr String] -> [Sexpr String])
-> ([Sexpr String], [String]) -> ([Sexpr String], [String])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first) (String -> [Sexpr String] -> Sexpr String
forall a. String -> [Sexpr a] -> Sexpr a
Combo String
open [Sexpr String]
inner Sexpr String -> [Sexpr String] -> [Sexpr String]
forall a. a -> [a] -> [a]
:) ([String] -> Maybe ([Sexpr String], [String])
go [String]
rest')
        [String]
_ -> Maybe ([Sexpr String], [String])
forall a. Maybe a
Nothing
    String
_ -> ((([Sexpr String], [String]) -> ([Sexpr String], [String]))
-> Maybe ([Sexpr String], [String])
-> Maybe ([Sexpr String], [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((([Sexpr String], [String]) -> ([Sexpr String], [String]))
 -> Maybe ([Sexpr String], [String])
 -> Maybe ([Sexpr String], [String]))
-> (([Sexpr String] -> [Sexpr String])
    -> ([Sexpr String], [String]) -> ([Sexpr String], [String]))
-> ([Sexpr String] -> [Sexpr String])
-> Maybe ([Sexpr String], [String])
-> Maybe ([Sexpr String], [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Sexpr String] -> [Sexpr String])
-> ([Sexpr String], [String]) -> ([Sexpr String], [String])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first) (String -> Sexpr String
forall a. a -> Sexpr a
Atom String
tSexpr String -> [Sexpr String] -> [Sexpr String]
forall a. a -> [a] -> [a]
:) ([String] -> Maybe ([Sexpr String], [String])
go [String]
ts)

tokenize :: String -> [String]
tokenize :: String -> [String]
tokenize String
input = do
  String
line <- String -> [String]
lines String
input
  case String
line of
    Char
'#':String
_ -> [] -- remove comment lines
    String
_ -> do
      String
word <- String -> [String]
words String
line
      String -> [String]
unbracket String
word

unbracket :: String -> [String]
unbracket :: String -> [String]
unbracket = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
loop String
""
  where
  loop :: String -> String -> [String]
loop String
acc String
"" = [ShowS
forall a. [a] -> [a]
reverse String
acc]
  loop String
acc (Char
'$':Char
'(':String
cs) = ShowS
forall a. [a] -> [a]
reverse String
acc String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"$(" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> String -> [String]
loop String
"" String
cs
  loop String
acc (Char
c:String
cs)
    | Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"()[]{}" = ShowS
forall a. [a] -> [a]
reverse String
acc String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [Char
c] String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> String -> [String]
loop String
"" String
cs
    | Bool
otherwise = String -> String -> [String]
loop (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
acc) String
cs

hydrateSpaces :: String -> String
hydrateSpaces :: ShowS
hydrateSpaces (Char
'\"':String
content) = ShowS
go String
content
  where
  go :: ShowS
go [] = []
  go (Char
'\\':Char
'\\':String
rest) = Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
go String
rest
  go (Char
'\\':Char
'+':String
rest) = Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
go String
rest
  go (Char
c:String
rest) = Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:ShowS
go String
rest
hydrateSpaces String
str = String
str

print :: (a -> String) -> Sexpr a -> String
print :: forall a. (a -> String) -> Sexpr a -> String
print a -> String
f (Atom a
a) = a -> String
f a
a
print a -> String
f (Combo String
open [Sexpr a]
sexprs) = case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
open [(String, String)]
brackPairs of
  Just String
close -> String
open String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((a -> String) -> Sexpr a -> String
forall a. (a -> String) -> Sexpr a -> String
print a -> String
f (Sexpr a -> String) -> [Sexpr a] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Sexpr a]
sexprs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
close
  Maybe String
Nothing -> ShowS
forall a. String -> a
errorWithoutStackTrace ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"Text.Parse.Stupid.print: not an open bracket " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
open