{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE PatternSynonyms      #-}
{-# LANGUAGE Trustworthy          #-}
{-# LANGUAGE TypeSynonymInstances #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Language.Sexp.Located
  (
  -- * Parse and print
    decode
  , parseSexp
  , parseSexps
  , parseSexpWithPos
  , parseSexpsWithPos
  , encode
  , format
  -- * Type
  , Sexp
  , pattern Atom
  , pattern Number
  , pattern Symbol
  , pattern String
  , pattern ParenList
  , pattern BracketList
  , pattern BraceList
  , pattern Modified
  -- ** Internal types
  , SexpF (..)
  , Atom (..)
  , Prefix (..)
  , LocatedBy (..)
  , Position (..)
  , Compose (..)
  , Fix (..)
  , dummyPos
  -- * Conversion
  , fromSimple
  , toSimple
  ) where

import Data.ByteString.Lazy.Char8 (ByteString, unpack)
import Data.Functor.Compose
import Data.Scientific (Scientific)
import Data.Text (Text)

import Language.Sexp.Types
import Language.Sexp.Lexer (lexSexp)
import Language.Sexp.Parser (parseSexp_, parseSexps_)
import qualified Language.Sexp.Pretty as Internal
import qualified Language.Sexp.Encode as Internal

-- | S-expression type annotated with positions. Useful for further
-- parsing.
type Sexp = Fix (Compose (LocatedBy Position) SexpF)

instance {-# OVERLAPPING #-} Show Sexp where
  show :: Sexp -> String
show = ByteString -> String
unpack (ByteString -> String) -> (Sexp -> ByteString) -> Sexp -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sexp -> ByteString
encode

-- | Deserialise a 'Sexp' from a string
decode :: ByteString -> Either String Sexp
decode :: ByteString -> Either String Sexp
decode = String -> ByteString -> Either String Sexp
parseSexp String
"<string>"

-- | Serialise a 'Sexp' into a compact string
encode :: Sexp -> ByteString
encode :: Sexp -> ByteString
encode = Fix SexpF -> ByteString
Internal.encode (Fix SexpF -> ByteString)
-> (Sexp -> Fix SexpF) -> Sexp -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sexp -> Fix SexpF
forall (f :: * -> *) p.
Functor f =>
Fix (Compose (LocatedBy p) f) -> Fix f
stripLocation

-- | Serialise a 'Sexp' into a pretty-printed string
format :: Sexp -> ByteString
format :: Sexp -> ByteString
format = Fix SexpF -> ByteString
Internal.format (Fix SexpF -> ByteString)
-> (Sexp -> Fix SexpF) -> Sexp -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sexp -> Fix SexpF
forall (f :: * -> *) p.
Functor f =>
Fix (Compose (LocatedBy p) f) -> Fix f
stripLocation

----------------------------------------------------------------------

fromSimple :: Fix SexpF -> Fix (Compose (LocatedBy Position) SexpF)
fromSimple :: Fix SexpF -> Sexp
fromSimple = Position -> Fix SexpF -> Sexp
forall (f :: * -> *) p.
Functor f =>
p -> Fix f -> Fix (Compose (LocatedBy p) f)
addLocation Position
dummyPos

toSimple :: Fix (Compose (LocatedBy Position) SexpF) -> Fix SexpF
toSimple :: Sexp -> Fix SexpF
toSimple = Sexp -> Fix SexpF
forall (f :: * -> *) p.
Functor f =>
Fix (Compose (LocatedBy p) f) -> Fix f
stripLocation

----------------------------------------------------------------------

pattern Atom :: Atom -> Sexp
pattern $bAtom :: Atom -> Sexp
$mAtom :: forall r. Sexp -> (Atom -> r) -> (Void# -> r) -> r
Atom a <- Fix (Compose (_ :< AtomF a))
  where Atom Atom
a =  Compose (LocatedBy Position) SexpF Sexp -> Sexp
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (LocatedBy Position (SexpF Sexp)
-> Compose (LocatedBy Position) SexpF Sexp
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Position
dummyPos Position -> SexpF Sexp -> LocatedBy Position (SexpF Sexp)
forall a e. a -> e -> LocatedBy a e
:< Atom -> SexpF Sexp
forall e. Atom -> SexpF e
AtomF Atom
a))

pattern Number :: Scientific -> Sexp
pattern $bNumber :: Scientific -> Sexp
$mNumber :: forall r. Sexp -> (Scientific -> r) -> (Void# -> r) -> r
Number a <- Fix (Compose (_ :< AtomF (AtomNumber a)))
  where Number Scientific
a =  Compose (LocatedBy Position) SexpF Sexp -> Sexp
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (LocatedBy Position (SexpF Sexp)
-> Compose (LocatedBy Position) SexpF Sexp
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Position
dummyPos Position -> SexpF Sexp -> LocatedBy Position (SexpF Sexp)
forall a e. a -> e -> LocatedBy a e
:< Atom -> SexpF Sexp
forall e. Atom -> SexpF e
AtomF (Scientific -> Atom
AtomNumber Scientific
a)))

pattern Symbol :: Text -> Sexp
pattern $bSymbol :: Text -> Sexp
$mSymbol :: forall r. Sexp -> (Text -> r) -> (Void# -> r) -> r
Symbol a <- Fix (Compose (_ :< AtomF (AtomSymbol a)))
  where Symbol Text
a =  Compose (LocatedBy Position) SexpF Sexp -> Sexp
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (LocatedBy Position (SexpF Sexp)
-> Compose (LocatedBy Position) SexpF Sexp
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Position
dummyPos Position -> SexpF Sexp -> LocatedBy Position (SexpF Sexp)
forall a e. a -> e -> LocatedBy a e
:< Atom -> SexpF Sexp
forall e. Atom -> SexpF e
AtomF (Text -> Atom
AtomSymbol Text
a)))

pattern String :: Text -> Sexp
pattern $bString :: Text -> Sexp
$mString :: forall r. Sexp -> (Text -> r) -> (Void# -> r) -> r
String a <- Fix (Compose (_ :< AtomF (AtomString a)))
  where String Text
a =  Compose (LocatedBy Position) SexpF Sexp -> Sexp
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (LocatedBy Position (SexpF Sexp)
-> Compose (LocatedBy Position) SexpF Sexp
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Position
dummyPos Position -> SexpF Sexp -> LocatedBy Position (SexpF Sexp)
forall a e. a -> e -> LocatedBy a e
:< Atom -> SexpF Sexp
forall e. Atom -> SexpF e
AtomF (Text -> Atom
AtomString Text
a)))

pattern ParenList :: [Sexp] -> Sexp
pattern $bParenList :: [Sexp] -> Sexp
$mParenList :: forall r. Sexp -> ([Sexp] -> r) -> (Void# -> r) -> r
ParenList ls <- Fix (Compose (_ :< ParenListF ls))
  where ParenList [Sexp]
ls =  Compose (LocatedBy Position) SexpF Sexp -> Sexp
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (LocatedBy Position (SexpF Sexp)
-> Compose (LocatedBy Position) SexpF Sexp
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Position
dummyPos Position -> SexpF Sexp -> LocatedBy Position (SexpF Sexp)
forall a e. a -> e -> LocatedBy a e
:< [Sexp] -> SexpF Sexp
forall e. [e] -> SexpF e
ParenListF [Sexp]
ls))

pattern BracketList :: [Sexp] -> Sexp
pattern $bBracketList :: [Sexp] -> Sexp
$mBracketList :: forall r. Sexp -> ([Sexp] -> r) -> (Void# -> r) -> r
BracketList ls <- Fix (Compose (_ :< BracketListF ls))
  where BracketList [Sexp]
ls =  Compose (LocatedBy Position) SexpF Sexp -> Sexp
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (LocatedBy Position (SexpF Sexp)
-> Compose (LocatedBy Position) SexpF Sexp
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Position
dummyPos Position -> SexpF Sexp -> LocatedBy Position (SexpF Sexp)
forall a e. a -> e -> LocatedBy a e
:< [Sexp] -> SexpF Sexp
forall e. [e] -> SexpF e
BracketListF [Sexp]
ls))

pattern BraceList :: [Sexp] -> Sexp
pattern $bBraceList :: [Sexp] -> Sexp
$mBraceList :: forall r. Sexp -> ([Sexp] -> r) -> (Void# -> r) -> r
BraceList ls <- Fix (Compose (_ :< BraceListF ls))
  where BraceList [Sexp]
ls =  Compose (LocatedBy Position) SexpF Sexp -> Sexp
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (LocatedBy Position (SexpF Sexp)
-> Compose (LocatedBy Position) SexpF Sexp
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Position
dummyPos Position -> SexpF Sexp -> LocatedBy Position (SexpF Sexp)
forall a e. a -> e -> LocatedBy a e
:< [Sexp] -> SexpF Sexp
forall e. [e] -> SexpF e
BraceListF [Sexp]
ls))

pattern Modified :: Prefix -> Sexp -> Sexp
pattern $bModified :: Prefix -> Sexp -> Sexp
$mModified :: forall r. Sexp -> (Prefix -> Sexp -> r) -> (Void# -> r) -> r
Modified q s <- Fix (Compose (_ :< ModifiedF q s))
  where Modified Prefix
q Sexp
s =  Compose (LocatedBy Position) SexpF Sexp -> Sexp
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (LocatedBy Position (SexpF Sexp)
-> Compose (LocatedBy Position) SexpF Sexp
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Position
dummyPos Position -> SexpF Sexp -> LocatedBy Position (SexpF Sexp)
forall a e. a -> e -> LocatedBy a e
:< Prefix -> Sexp -> SexpF Sexp
forall e. Prefix -> e -> SexpF e
ModifiedF Prefix
q Sexp
s))

-- | Parse a 'Sexp' from a string.
parseSexp :: FilePath -> ByteString -> Either String Sexp
parseSexp :: String -> ByteString -> Either String Sexp
parseSexp String
fn ByteString
inp = [LocatedBy Position Token] -> Either String Sexp
parseSexp_ (Position -> ByteString -> [LocatedBy Position Token]
lexSexp (String -> Int -> Int -> Position
Position String
fn Int
1 Int
0) ByteString
inp)

-- | Parse multiple 'Sexp' from a string.
parseSexps :: FilePath -> ByteString -> Either String [Sexp]
parseSexps :: String -> ByteString -> Either String [Sexp]
parseSexps String
fn ByteString
inp = [LocatedBy Position Token] -> Either String [Sexp]
parseSexps_ (Position -> ByteString -> [LocatedBy Position Token]
lexSexp (String -> Int -> Int -> Position
Position String
fn Int
1 Int
0) ByteString
inp)

-- | Parse a 'Sexp' from a string, starting from a given
-- position. Useful for embedding into other parsers.
parseSexpWithPos :: Position -> ByteString -> Either String Sexp
parseSexpWithPos :: Position -> ByteString -> Either String Sexp
parseSexpWithPos Position
pos ByteString
inp = [LocatedBy Position Token] -> Either String Sexp
parseSexp_ (Position -> ByteString -> [LocatedBy Position Token]
lexSexp Position
pos ByteString
inp)

-- | Parse multiple 'Sexp' from a string, starting from a given
-- position. Useful for embedding into other parsers.
parseSexpsWithPos :: Position -> ByteString -> Either String [Sexp]
parseSexpsWithPos :: Position -> ByteString -> Either String [Sexp]
parseSexpsWithPos Position
pos ByteString
inp = [LocatedBy Position Token] -> Either String [Sexp]
parseSexps_ (Position -> ByteString -> [LocatedBy Position Token]
lexSexp Position
pos ByteString
inp)