{-# LANGUAGE DeriveFoldable      #-}
{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE DeriveTraversable   #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE LambdaCase          #-}

module Language.Sexp.Types
  ( Atom (..)
  , Prefix (..)
  , Fix (..)
  , SexpF (..)
  , Compose (..)
  , Position (..)
  , dummyPos
  , LocatedBy (..)
  , location
  , extract
  , stripLocation
  , addLocation
  ) where

import Control.DeepSeq

import Data.Bifunctor

import Data.Fix (Fix (..))
import Data.Functor.Classes
import Data.Functor.Compose
import Data.Functor.Foldable (cata)
import Data.Scientific (Scientific)
import Data.Text (Text)
import Data.Text.Prettyprint.Doc (Pretty (..), colon, (<>))
import GHC.Generics

----------------------------------------------------------------------
-- Positions

-- | Position: file name, line number, column number
data Position =
  Position FilePath {-# UNPACK #-} !Int {-# UNPACK #-} !Int
  deriving (Eq Position
Eq Position
-> (Position -> Position -> Ordering)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Position)
-> (Position -> Position -> Position)
-> Ord Position
Position -> Position -> Bool
Position -> Position -> Ordering
Position -> Position -> Position
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
min :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmax :: Position -> Position -> Position
>= :: Position -> Position -> Bool
$c>= :: Position -> Position -> Bool
> :: Position -> Position -> Bool
$c> :: Position -> Position -> Bool
<= :: Position -> Position -> Bool
$c<= :: Position -> Position -> Bool
< :: Position -> Position -> Bool
$c< :: Position -> Position -> Bool
compare :: Position -> Position -> Ordering
$ccompare :: Position -> Position -> Ordering
$cp1Ord :: Eq Position
Ord, Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c== :: Position -> Position -> Bool
Eq, (forall x. Position -> Rep Position x)
-> (forall x. Rep Position x -> Position) -> Generic Position
forall x. Rep Position x -> Position
forall x. Position -> Rep Position x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Position x -> Position
$cfrom :: forall x. Position -> Rep Position x
Generic)

dummyPos :: Position
dummyPos :: Position
dummyPos = FilePath -> Int -> Int -> Position
Position FilePath
"<no location information>" Int
1 Int
0

instance Pretty Position where
  pretty :: Position -> Doc ann
pretty (Position FilePath
fn Int
line Int
col) =
    FilePath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
fn Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
col

instance Show Position where
  show :: Position -> FilePath
show (Position FilePath
fn Int
line Int
col) =
    FilePath
fn FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
":" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
line FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
":" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
col

----------------------------------------------------------------------
-- Annotations

-- | Annotation functor for positions
data LocatedBy a e = !a :< e
    deriving (Int -> LocatedBy a e -> ShowS
[LocatedBy a e] -> ShowS
LocatedBy a e -> FilePath
(Int -> LocatedBy a e -> ShowS)
-> (LocatedBy a e -> FilePath)
-> ([LocatedBy a e] -> ShowS)
-> Show (LocatedBy a e)
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall a e. (Show a, Show e) => Int -> LocatedBy a e -> ShowS
forall a e. (Show a, Show e) => [LocatedBy a e] -> ShowS
forall a e. (Show a, Show e) => LocatedBy a e -> FilePath
showList :: [LocatedBy a e] -> ShowS
$cshowList :: forall a e. (Show a, Show e) => [LocatedBy a e] -> ShowS
show :: LocatedBy a e -> FilePath
$cshow :: forall a e. (Show a, Show e) => LocatedBy a e -> FilePath
showsPrec :: Int -> LocatedBy a e -> ShowS
$cshowsPrec :: forall a e. (Show a, Show e) => Int -> LocatedBy a e -> ShowS
Show, LocatedBy a e -> LocatedBy a e -> Bool
(LocatedBy a e -> LocatedBy a e -> Bool)
-> (LocatedBy a e -> LocatedBy a e -> Bool) -> Eq (LocatedBy a e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a e. (Eq a, Eq e) => LocatedBy a e -> LocatedBy a e -> Bool
/= :: LocatedBy a e -> LocatedBy a e -> Bool
$c/= :: forall a e. (Eq a, Eq e) => LocatedBy a e -> LocatedBy a e -> Bool
== :: LocatedBy a e -> LocatedBy a e -> Bool
$c== :: forall a e. (Eq a, Eq e) => LocatedBy a e -> LocatedBy a e -> Bool
Eq, Eq (LocatedBy a e)
Eq (LocatedBy a e)
-> (LocatedBy a e -> LocatedBy a e -> Ordering)
-> (LocatedBy a e -> LocatedBy a e -> Bool)
-> (LocatedBy a e -> LocatedBy a e -> Bool)
-> (LocatedBy a e -> LocatedBy a e -> Bool)
-> (LocatedBy a e -> LocatedBy a e -> Bool)
-> (LocatedBy a e -> LocatedBy a e -> LocatedBy a e)
-> (LocatedBy a e -> LocatedBy a e -> LocatedBy a e)
-> Ord (LocatedBy a e)
LocatedBy a e -> LocatedBy a e -> Bool
LocatedBy a e -> LocatedBy a e -> Ordering
LocatedBy a e -> LocatedBy a e -> LocatedBy a e
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 e. (Ord a, Ord e) => Eq (LocatedBy a e)
forall a e.
(Ord a, Ord e) =>
LocatedBy a e -> LocatedBy a e -> Bool
forall a e.
(Ord a, Ord e) =>
LocatedBy a e -> LocatedBy a e -> Ordering
forall a e.
(Ord a, Ord e) =>
LocatedBy a e -> LocatedBy a e -> LocatedBy a e
min :: LocatedBy a e -> LocatedBy a e -> LocatedBy a e
$cmin :: forall a e.
(Ord a, Ord e) =>
LocatedBy a e -> LocatedBy a e -> LocatedBy a e
max :: LocatedBy a e -> LocatedBy a e -> LocatedBy a e
$cmax :: forall a e.
(Ord a, Ord e) =>
LocatedBy a e -> LocatedBy a e -> LocatedBy a e
>= :: LocatedBy a e -> LocatedBy a e -> Bool
$c>= :: forall a e.
(Ord a, Ord e) =>
LocatedBy a e -> LocatedBy a e -> Bool
> :: LocatedBy a e -> LocatedBy a e -> Bool
$c> :: forall a e.
(Ord a, Ord e) =>
LocatedBy a e -> LocatedBy a e -> Bool
<= :: LocatedBy a e -> LocatedBy a e -> Bool
$c<= :: forall a e.
(Ord a, Ord e) =>
LocatedBy a e -> LocatedBy a e -> Bool
< :: LocatedBy a e -> LocatedBy a e -> Bool
$c< :: forall a e.
(Ord a, Ord e) =>
LocatedBy a e -> LocatedBy a e -> Bool
compare :: LocatedBy a e -> LocatedBy a e -> Ordering
$ccompare :: forall a e.
(Ord a, Ord e) =>
LocatedBy a e -> LocatedBy a e -> Ordering
$cp1Ord :: forall a e. (Ord a, Ord e) => Eq (LocatedBy a e)
Ord, a -> LocatedBy a b -> LocatedBy a a
(a -> b) -> LocatedBy a a -> LocatedBy a b
(forall a b. (a -> b) -> LocatedBy a a -> LocatedBy a b)
-> (forall a b. a -> LocatedBy a b -> LocatedBy a a)
-> Functor (LocatedBy a)
forall a b. a -> LocatedBy a b -> LocatedBy a a
forall a b. (a -> b) -> LocatedBy a a -> LocatedBy a b
forall a a b. a -> LocatedBy a b -> LocatedBy a a
forall a a b. (a -> b) -> LocatedBy a a -> LocatedBy a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LocatedBy a b -> LocatedBy a a
$c<$ :: forall a a b. a -> LocatedBy a b -> LocatedBy a a
fmap :: (a -> b) -> LocatedBy a a -> LocatedBy a b
$cfmap :: forall a a b. (a -> b) -> LocatedBy a a -> LocatedBy a b
Functor, LocatedBy a a -> Bool
(a -> m) -> LocatedBy a a -> m
(a -> b -> b) -> b -> LocatedBy a a -> b
(forall m. Monoid m => LocatedBy a m -> m)
-> (forall m a. Monoid m => (a -> m) -> LocatedBy a a -> m)
-> (forall m a. Monoid m => (a -> m) -> LocatedBy a a -> m)
-> (forall a b. (a -> b -> b) -> b -> LocatedBy a a -> b)
-> (forall a b. (a -> b -> b) -> b -> LocatedBy a a -> b)
-> (forall b a. (b -> a -> b) -> b -> LocatedBy a a -> b)
-> (forall b a. (b -> a -> b) -> b -> LocatedBy a a -> b)
-> (forall a. (a -> a -> a) -> LocatedBy a a -> a)
-> (forall a. (a -> a -> a) -> LocatedBy a a -> a)
-> (forall a. LocatedBy a a -> [a])
-> (forall a. LocatedBy a a -> Bool)
-> (forall a. LocatedBy a a -> Int)
-> (forall a. Eq a => a -> LocatedBy a a -> Bool)
-> (forall a. Ord a => LocatedBy a a -> a)
-> (forall a. Ord a => LocatedBy a a -> a)
-> (forall a. Num a => LocatedBy a a -> a)
-> (forall a. Num a => LocatedBy a a -> a)
-> Foldable (LocatedBy a)
forall a. Eq a => a -> LocatedBy a a -> Bool
forall a. Num a => LocatedBy a a -> a
forall a. Ord a => LocatedBy a a -> a
forall m. Monoid m => LocatedBy a m -> m
forall a. LocatedBy a a -> Bool
forall a. LocatedBy a a -> Int
forall a. LocatedBy a a -> [a]
forall a. (a -> a -> a) -> LocatedBy a a -> a
forall a a. Eq a => a -> LocatedBy a a -> Bool
forall a a. Num a => LocatedBy a a -> a
forall a a. Ord a => LocatedBy a a -> a
forall m a. Monoid m => (a -> m) -> LocatedBy a a -> m
forall a m. Monoid m => LocatedBy a m -> m
forall a a. LocatedBy a a -> Bool
forall a a. LocatedBy a a -> Int
forall a a. LocatedBy a a -> [a]
forall b a. (b -> a -> b) -> b -> LocatedBy a a -> b
forall a b. (a -> b -> b) -> b -> LocatedBy a a -> b
forall a a. (a -> a -> a) -> LocatedBy a a -> a
forall a m a. Monoid m => (a -> m) -> LocatedBy a a -> m
forall a b a. (b -> a -> b) -> b -> LocatedBy a a -> b
forall a a b. (a -> b -> b) -> b -> LocatedBy a a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: LocatedBy a a -> a
$cproduct :: forall a a. Num a => LocatedBy a a -> a
sum :: LocatedBy a a -> a
$csum :: forall a a. Num a => LocatedBy a a -> a
minimum :: LocatedBy a a -> a
$cminimum :: forall a a. Ord a => LocatedBy a a -> a
maximum :: LocatedBy a a -> a
$cmaximum :: forall a a. Ord a => LocatedBy a a -> a
elem :: a -> LocatedBy a a -> Bool
$celem :: forall a a. Eq a => a -> LocatedBy a a -> Bool
length :: LocatedBy a a -> Int
$clength :: forall a a. LocatedBy a a -> Int
null :: LocatedBy a a -> Bool
$cnull :: forall a a. LocatedBy a a -> Bool
toList :: LocatedBy a a -> [a]
$ctoList :: forall a a. LocatedBy a a -> [a]
foldl1 :: (a -> a -> a) -> LocatedBy a a -> a
$cfoldl1 :: forall a a. (a -> a -> a) -> LocatedBy a a -> a
foldr1 :: (a -> a -> a) -> LocatedBy a a -> a
$cfoldr1 :: forall a a. (a -> a -> a) -> LocatedBy a a -> a
foldl' :: (b -> a -> b) -> b -> LocatedBy a a -> b
$cfoldl' :: forall a b a. (b -> a -> b) -> b -> LocatedBy a a -> b
foldl :: (b -> a -> b) -> b -> LocatedBy a a -> b
$cfoldl :: forall a b a. (b -> a -> b) -> b -> LocatedBy a a -> b
foldr' :: (a -> b -> b) -> b -> LocatedBy a a -> b
$cfoldr' :: forall a a b. (a -> b -> b) -> b -> LocatedBy a a -> b
foldr :: (a -> b -> b) -> b -> LocatedBy a a -> b
$cfoldr :: forall a a b. (a -> b -> b) -> b -> LocatedBy a a -> b
foldMap' :: (a -> m) -> LocatedBy a a -> m
$cfoldMap' :: forall a m a. Monoid m => (a -> m) -> LocatedBy a a -> m
foldMap :: (a -> m) -> LocatedBy a a -> m
$cfoldMap :: forall a m a. Monoid m => (a -> m) -> LocatedBy a a -> m
fold :: LocatedBy a m -> m
$cfold :: forall a m. Monoid m => LocatedBy a m -> m
Foldable, Functor (LocatedBy a)
Foldable (LocatedBy a)
Functor (LocatedBy a)
-> Foldable (LocatedBy a)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> LocatedBy a a -> f (LocatedBy a b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    LocatedBy a (f a) -> f (LocatedBy a a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> LocatedBy a a -> m (LocatedBy a b))
-> (forall (m :: * -> *) a.
    Monad m =>
    LocatedBy a (m a) -> m (LocatedBy a a))
-> Traversable (LocatedBy a)
(a -> f b) -> LocatedBy a a -> f (LocatedBy a b)
forall a. Functor (LocatedBy a)
forall a. Foldable (LocatedBy a)
forall a (m :: * -> *) a.
Monad m =>
LocatedBy a (m a) -> m (LocatedBy a a)
forall a (f :: * -> *) a.
Applicative f =>
LocatedBy a (f a) -> f (LocatedBy a a)
forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LocatedBy a a -> m (LocatedBy a b)
forall a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LocatedBy a a -> f (LocatedBy a b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
LocatedBy a (m a) -> m (LocatedBy a a)
forall (f :: * -> *) a.
Applicative f =>
LocatedBy a (f a) -> f (LocatedBy a a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LocatedBy a a -> m (LocatedBy a b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LocatedBy a a -> f (LocatedBy a b)
sequence :: LocatedBy a (m a) -> m (LocatedBy a a)
$csequence :: forall a (m :: * -> *) a.
Monad m =>
LocatedBy a (m a) -> m (LocatedBy a a)
mapM :: (a -> m b) -> LocatedBy a a -> m (LocatedBy a b)
$cmapM :: forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LocatedBy a a -> m (LocatedBy a b)
sequenceA :: LocatedBy a (f a) -> f (LocatedBy a a)
$csequenceA :: forall a (f :: * -> *) a.
Applicative f =>
LocatedBy a (f a) -> f (LocatedBy a a)
traverse :: (a -> f b) -> LocatedBy a a -> f (LocatedBy a b)
$ctraverse :: forall a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LocatedBy a a -> f (LocatedBy a b)
$cp2Traversable :: forall a. Foldable (LocatedBy a)
$cp1Traversable :: forall a. Functor (LocatedBy a)
Traversable, (forall x. LocatedBy a e -> Rep (LocatedBy a e) x)
-> (forall x. Rep (LocatedBy a e) x -> LocatedBy a e)
-> Generic (LocatedBy a e)
forall x. Rep (LocatedBy a e) x -> LocatedBy a e
forall x. LocatedBy a e -> Rep (LocatedBy a e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a e x. Rep (LocatedBy a e) x -> LocatedBy a e
forall a e x. LocatedBy a e -> Rep (LocatedBy a e) x
$cto :: forall a e x. Rep (LocatedBy a e) x -> LocatedBy a e
$cfrom :: forall a e x. LocatedBy a e -> Rep (LocatedBy a e) x
Generic)

instance Bifunctor LocatedBy where
  bimap :: (a -> b) -> (c -> d) -> LocatedBy a c -> LocatedBy b d
bimap a -> b
f c -> d
g (a
a :< c
e) = a -> b
f a
a b -> d -> LocatedBy b d
forall a e. a -> e -> LocatedBy a e
:< c -> d
g c
e

instance (Eq p) => Eq1 (LocatedBy p) where
  liftEq :: (a -> b -> Bool) -> LocatedBy p a -> LocatedBy p b -> Bool
liftEq a -> b -> Bool
eq (p
p :< a
a) (p
q :< b
b) = p
p p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
q Bool -> Bool -> Bool
&& a
a a -> b -> Bool
`eq` b
b

location :: LocatedBy a e -> a
location :: LocatedBy a e -> a
location (a
a :< e
_) = a
a

extract :: LocatedBy a e -> e
extract :: LocatedBy a e -> e
extract (a
_ :< e
e) = e
e

stripLocation :: (Functor f) => Fix (Compose (LocatedBy p) f) -> Fix f
stripLocation :: Fix (Compose (LocatedBy p) f) -> Fix f
stripLocation = (Base (Fix (Compose (LocatedBy p) f)) (Fix f) -> Fix f)
-> Fix (Compose (LocatedBy p) f) -> Fix f
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata (f (Fix f) -> Fix f
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (f (Fix f) -> Fix f)
-> (Compose (LocatedBy p) f (Fix f) -> f (Fix f))
-> Compose (LocatedBy p) f (Fix f)
-> Fix f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedBy p (f (Fix f)) -> f (Fix f)
forall a e. LocatedBy a e -> e
extract (LocatedBy p (f (Fix f)) -> f (Fix f))
-> (Compose (LocatedBy p) f (Fix f) -> LocatedBy p (f (Fix f)))
-> Compose (LocatedBy p) f (Fix f)
-> f (Fix f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (LocatedBy p) f (Fix f) -> LocatedBy p (f (Fix f))
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose)

addLocation :: (Functor f) => p -> Fix f -> Fix (Compose (LocatedBy p) f)
addLocation :: p -> Fix f -> Fix (Compose (LocatedBy p) f)
addLocation p
p = (Base (Fix f) (Fix (Compose (LocatedBy p) f))
 -> Fix (Compose (LocatedBy p) f))
-> Fix f -> Fix (Compose (LocatedBy p) f)
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata (Compose (LocatedBy p) f (Fix (Compose (LocatedBy p) f))
-> Fix (Compose (LocatedBy p) f)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Compose (LocatedBy p) f (Fix (Compose (LocatedBy p) f))
 -> Fix (Compose (LocatedBy p) f))
-> (f (Fix (Compose (LocatedBy p) f))
    -> Compose (LocatedBy p) f (Fix (Compose (LocatedBy p) f)))
-> f (Fix (Compose (LocatedBy p) f))
-> Fix (Compose (LocatedBy p) f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedBy p (f (Fix (Compose (LocatedBy p) f)))
-> Compose (LocatedBy p) f (Fix (Compose (LocatedBy p) f))
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (LocatedBy p (f (Fix (Compose (LocatedBy p) f)))
 -> Compose (LocatedBy p) f (Fix (Compose (LocatedBy p) f)))
-> (f (Fix (Compose (LocatedBy p) f))
    -> LocatedBy p (f (Fix (Compose (LocatedBy p) f))))
-> f (Fix (Compose (LocatedBy p) f))
-> Compose (LocatedBy p) f (Fix (Compose (LocatedBy p) f))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p
p p
-> f (Fix (Compose (LocatedBy p) f))
-> LocatedBy p (f (Fix (Compose (LocatedBy p) f)))
forall a e. a -> e -> LocatedBy a e
:<))

----------------------------------------------------------------------
-- Sexp

-- | S-expression atom type
data Atom
  = AtomNumber {-# UNPACK #-} !Scientific
  | AtomString {-# UNPACK #-} !Text
  | AtomSymbol {-# UNPACK #-} !Text
    deriving (Int -> Atom -> ShowS
[Atom] -> ShowS
Atom -> FilePath
(Int -> Atom -> ShowS)
-> (Atom -> FilePath) -> ([Atom] -> ShowS) -> Show Atom
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Atom] -> ShowS
$cshowList :: [Atom] -> ShowS
show :: Atom -> FilePath
$cshow :: Atom -> FilePath
showsPrec :: Int -> Atom -> ShowS
$cshowsPrec :: Int -> Atom -> ShowS
Show, Atom -> Atom -> Bool
(Atom -> Atom -> Bool) -> (Atom -> Atom -> Bool) -> Eq Atom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Atom -> Atom -> Bool
$c/= :: Atom -> Atom -> Bool
== :: Atom -> Atom -> Bool
$c== :: Atom -> Atom -> Bool
Eq, Eq Atom
Eq Atom
-> (Atom -> Atom -> Ordering)
-> (Atom -> Atom -> Bool)
-> (Atom -> Atom -> Bool)
-> (Atom -> Atom -> Bool)
-> (Atom -> Atom -> Bool)
-> (Atom -> Atom -> Atom)
-> (Atom -> Atom -> Atom)
-> Ord Atom
Atom -> Atom -> Bool
Atom -> Atom -> Ordering
Atom -> Atom -> Atom
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
min :: Atom -> Atom -> Atom
$cmin :: Atom -> Atom -> Atom
max :: Atom -> Atom -> Atom
$cmax :: Atom -> Atom -> Atom
>= :: Atom -> Atom -> Bool
$c>= :: Atom -> Atom -> Bool
> :: Atom -> Atom -> Bool
$c> :: Atom -> Atom -> Bool
<= :: Atom -> Atom -> Bool
$c<= :: Atom -> Atom -> Bool
< :: Atom -> Atom -> Bool
$c< :: Atom -> Atom -> Bool
compare :: Atom -> Atom -> Ordering
$ccompare :: Atom -> Atom -> Ordering
$cp1Ord :: Eq Atom
Ord, (forall x. Atom -> Rep Atom x)
-> (forall x. Rep Atom x -> Atom) -> Generic Atom
forall x. Rep Atom x -> Atom
forall x. Atom -> Rep Atom x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Atom x -> Atom
$cfrom :: forall x. Atom -> Rep Atom x
Generic)

-- | S-expression quotation type
data Prefix
  = Quote
  | Backtick
  | Comma
  | CommaAt
  | Hash
    deriving (Int -> Prefix -> ShowS
[Prefix] -> ShowS
Prefix -> FilePath
(Int -> Prefix -> ShowS)
-> (Prefix -> FilePath) -> ([Prefix] -> ShowS) -> Show Prefix
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Prefix] -> ShowS
$cshowList :: [Prefix] -> ShowS
show :: Prefix -> FilePath
$cshow :: Prefix -> FilePath
showsPrec :: Int -> Prefix -> ShowS
$cshowsPrec :: Int -> Prefix -> ShowS
Show, Prefix -> Prefix -> Bool
(Prefix -> Prefix -> Bool)
-> (Prefix -> Prefix -> Bool) -> Eq Prefix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prefix -> Prefix -> Bool
$c/= :: Prefix -> Prefix -> Bool
== :: Prefix -> Prefix -> Bool
$c== :: Prefix -> Prefix -> Bool
Eq, Eq Prefix
Eq Prefix
-> (Prefix -> Prefix -> Ordering)
-> (Prefix -> Prefix -> Bool)
-> (Prefix -> Prefix -> Bool)
-> (Prefix -> Prefix -> Bool)
-> (Prefix -> Prefix -> Bool)
-> (Prefix -> Prefix -> Prefix)
-> (Prefix -> Prefix -> Prefix)
-> Ord Prefix
Prefix -> Prefix -> Bool
Prefix -> Prefix -> Ordering
Prefix -> Prefix -> Prefix
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
min :: Prefix -> Prefix -> Prefix
$cmin :: Prefix -> Prefix -> Prefix
max :: Prefix -> Prefix -> Prefix
$cmax :: Prefix -> Prefix -> Prefix
>= :: Prefix -> Prefix -> Bool
$c>= :: Prefix -> Prefix -> Bool
> :: Prefix -> Prefix -> Bool
$c> :: Prefix -> Prefix -> Bool
<= :: Prefix -> Prefix -> Bool
$c<= :: Prefix -> Prefix -> Bool
< :: Prefix -> Prefix -> Bool
$c< :: Prefix -> Prefix -> Bool
compare :: Prefix -> Prefix -> Ordering
$ccompare :: Prefix -> Prefix -> Ordering
$cp1Ord :: Eq Prefix
Ord, (forall x. Prefix -> Rep Prefix x)
-> (forall x. Rep Prefix x -> Prefix) -> Generic Prefix
forall x. Rep Prefix x -> Prefix
forall x. Prefix -> Rep Prefix x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Prefix x -> Prefix
$cfrom :: forall x. Prefix -> Rep Prefix x
Generic)

instance NFData Prefix

-- | S-expression functor
data SexpF e
  = AtomF        !Atom
  | ParenListF   [e]
  | BracketListF [e]
  | BraceListF   [e]
  | ModifiedF    !Prefix e
    deriving (a -> SexpF b -> SexpF a
(a -> b) -> SexpF a -> SexpF b
(forall a b. (a -> b) -> SexpF a -> SexpF b)
-> (forall a b. a -> SexpF b -> SexpF a) -> Functor SexpF
forall a b. a -> SexpF b -> SexpF a
forall a b. (a -> b) -> SexpF a -> SexpF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SexpF b -> SexpF a
$c<$ :: forall a b. a -> SexpF b -> SexpF a
fmap :: (a -> b) -> SexpF a -> SexpF b
$cfmap :: forall a b. (a -> b) -> SexpF a -> SexpF b
Functor, SexpF a -> Bool
(a -> m) -> SexpF a -> m
(a -> b -> b) -> b -> SexpF a -> b
(forall m. Monoid m => SexpF m -> m)
-> (forall m a. Monoid m => (a -> m) -> SexpF a -> m)
-> (forall m a. Monoid m => (a -> m) -> SexpF a -> m)
-> (forall a b. (a -> b -> b) -> b -> SexpF a -> b)
-> (forall a b. (a -> b -> b) -> b -> SexpF a -> b)
-> (forall b a. (b -> a -> b) -> b -> SexpF a -> b)
-> (forall b a. (b -> a -> b) -> b -> SexpF a -> b)
-> (forall a. (a -> a -> a) -> SexpF a -> a)
-> (forall a. (a -> a -> a) -> SexpF a -> a)
-> (forall a. SexpF a -> [a])
-> (forall a. SexpF a -> Bool)
-> (forall a. SexpF a -> Int)
-> (forall a. Eq a => a -> SexpF a -> Bool)
-> (forall a. Ord a => SexpF a -> a)
-> (forall a. Ord a => SexpF a -> a)
-> (forall a. Num a => SexpF a -> a)
-> (forall a. Num a => SexpF a -> a)
-> Foldable SexpF
forall a. Eq a => a -> SexpF a -> Bool
forall a. Num a => SexpF a -> a
forall a. Ord a => SexpF a -> a
forall m. Monoid m => SexpF m -> m
forall a. SexpF a -> Bool
forall a. SexpF a -> Int
forall a. SexpF a -> [a]
forall a. (a -> a -> a) -> SexpF a -> a
forall m a. Monoid m => (a -> m) -> SexpF a -> m
forall b a. (b -> a -> b) -> b -> SexpF a -> b
forall a b. (a -> b -> b) -> b -> SexpF a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: SexpF a -> a
$cproduct :: forall a. Num a => SexpF a -> a
sum :: SexpF a -> a
$csum :: forall a. Num a => SexpF a -> a
minimum :: SexpF a -> a
$cminimum :: forall a. Ord a => SexpF a -> a
maximum :: SexpF a -> a
$cmaximum :: forall a. Ord a => SexpF a -> a
elem :: a -> SexpF a -> Bool
$celem :: forall a. Eq a => a -> SexpF a -> Bool
length :: SexpF a -> Int
$clength :: forall a. SexpF a -> Int
null :: SexpF a -> Bool
$cnull :: forall a. SexpF a -> Bool
toList :: SexpF a -> [a]
$ctoList :: forall a. SexpF a -> [a]
foldl1 :: (a -> a -> a) -> SexpF a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> SexpF a -> a
foldr1 :: (a -> a -> a) -> SexpF a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> SexpF a -> a
foldl' :: (b -> a -> b) -> b -> SexpF a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> SexpF a -> b
foldl :: (b -> a -> b) -> b -> SexpF a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> SexpF a -> b
foldr' :: (a -> b -> b) -> b -> SexpF a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> SexpF a -> b
foldr :: (a -> b -> b) -> b -> SexpF a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> SexpF a -> b
foldMap' :: (a -> m) -> SexpF a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> SexpF a -> m
foldMap :: (a -> m) -> SexpF a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> SexpF a -> m
fold :: SexpF m -> m
$cfold :: forall m. Monoid m => SexpF m -> m
Foldable, Functor SexpF
Foldable SexpF
Functor SexpF
-> Foldable SexpF
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> SexpF a -> f (SexpF b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    SexpF (f a) -> f (SexpF a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> SexpF a -> m (SexpF b))
-> (forall (m :: * -> *) a. Monad m => SexpF (m a) -> m (SexpF a))
-> Traversable SexpF
(a -> f b) -> SexpF a -> f (SexpF b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => SexpF (m a) -> m (SexpF a)
forall (f :: * -> *) a. Applicative f => SexpF (f a) -> f (SexpF a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SexpF a -> m (SexpF b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SexpF a -> f (SexpF b)
sequence :: SexpF (m a) -> m (SexpF a)
$csequence :: forall (m :: * -> *) a. Monad m => SexpF (m a) -> m (SexpF a)
mapM :: (a -> m b) -> SexpF a -> m (SexpF b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SexpF a -> m (SexpF b)
sequenceA :: SexpF (f a) -> f (SexpF a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => SexpF (f a) -> f (SexpF a)
traverse :: (a -> f b) -> SexpF a -> f (SexpF b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SexpF a -> f (SexpF b)
$cp2Traversable :: Foldable SexpF
$cp1Traversable :: Functor SexpF
Traversable, (forall x. SexpF e -> Rep (SexpF e) x)
-> (forall x. Rep (SexpF e) x -> SexpF e) -> Generic (SexpF e)
forall x. Rep (SexpF e) x -> SexpF e
forall x. SexpF e -> Rep (SexpF e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e x. Rep (SexpF e) x -> SexpF e
forall e x. SexpF e -> Rep (SexpF e) x
$cto :: forall e x. Rep (SexpF e) x -> SexpF e
$cfrom :: forall e x. SexpF e -> Rep (SexpF e) x
Generic)

instance Eq1 SexpF where
  liftEq :: (a -> b -> Bool) -> SexpF a -> SexpF b -> Bool
liftEq a -> b -> Bool
eq = SexpF a -> SexpF b -> Bool
go
    where
      go :: SexpF a -> SexpF b -> Bool
go (AtomF Atom
a) (AtomF Atom
b) = Atom
a Atom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
== Atom
b
      go (ParenListF [a]
as) (ParenListF [b]
bs) = (a -> b -> Bool) -> [a] -> [b] -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq [a]
as [b]
bs
      go (BracketListF [a]
as) (BracketListF [b]
bs) = (a -> b -> Bool) -> [a] -> [b] -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq [a]
as [b]
bs
      go (BraceListF [a]
as) (BraceListF [b]
bs) = (a -> b -> Bool) -> [a] -> [b] -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq [a]
as [b]
bs
      go (ModifiedF Prefix
q a
a) (ModifiedF Prefix
p b
b) = Prefix
q Prefix -> Prefix -> Bool
forall a. Eq a => a -> a -> Bool
== Prefix
p Bool -> Bool -> Bool
&& a
a a -> b -> Bool
`eq` b
b
      go SexpF a
_ SexpF b
_ = Bool
False

instance NFData Atom

instance NFData Position

instance NFData1 SexpF where
  liftRnf :: (a -> ()) -> SexpF a -> ()
liftRnf a -> ()
f = \case
    AtomF Atom
a -> Atom -> ()
forall a. NFData a => a -> ()
rnf Atom
a
    ParenListF [a]
as -> (a -> ()) -> [a] -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf a -> ()
f [a]
as
    BracketListF [a]
as -> (a -> ()) -> [a] -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf a -> ()
f [a]
as
    BraceListF [a]
as -> (a -> ()) -> [a] -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf a -> ()
f [a]
as
    ModifiedF Prefix
q a
a -> Prefix -> ()
forall a. NFData a => a -> ()
rnf Prefix
q () -> () -> ()
`seq` a -> ()
f a
a

instance NFData1 (Compose (LocatedBy Position) SexpF) where
  liftRnf :: (a -> ()) -> Compose (LocatedBy Position) SexpF a -> ()
liftRnf a -> ()
f = (a -> ()) -> SexpF a -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf a -> ()
f (SexpF a -> ())
-> (Compose (LocatedBy Position) SexpF a -> SexpF a)
-> Compose (LocatedBy Position) SexpF a
-> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedBy Position (SexpF a) -> SexpF a
forall a e. LocatedBy a e -> e
extract (LocatedBy Position (SexpF a) -> SexpF a)
-> (Compose (LocatedBy Position) SexpF a
    -> LocatedBy Position (SexpF a))
-> Compose (LocatedBy Position) SexpF a
-> SexpF a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (LocatedBy Position) SexpF a
-> LocatedBy Position (SexpF a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose