-- | This module provides the token type used in the lexer and
-- parser and provides the extra pass to insert layout tokens.
module Config.Tokens
  ( Token(..)
  , Located(..)
  , Position(..)
  , startPos
  , Error(..)
  , layoutPass
  ) where

import Data.Text (Text)
import Config.Number

-- | A position in a text file
data Position = Position
  { Position -> Int
posIndex, Position -> Int
posLine, Position -> Int
posColumn :: {-# UNPACK #-} !Int }
  deriving (ReadPrec [Position]
ReadPrec Position
Int -> ReadS Position
ReadS [Position]
(Int -> ReadS Position)
-> ReadS [Position]
-> ReadPrec Position
-> ReadPrec [Position]
-> Read Position
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Position]
$creadListPrec :: ReadPrec [Position]
readPrec :: ReadPrec Position
$creadPrec :: ReadPrec Position
readList :: ReadS [Position]
$creadList :: ReadS [Position]
readsPrec :: Int -> ReadS Position
$creadsPrec :: Int -> ReadS Position
Read, Int -> Position -> ShowS
[Position] -> ShowS
Position -> String
(Int -> Position -> ShowS)
-> (Position -> String) -> ([Position] -> ShowS) -> Show Position
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Position] -> ShowS
$cshowList :: [Position] -> ShowS
show :: Position -> String
$cshow :: Position -> String
showsPrec :: Int -> Position -> ShowS
$cshowsPrec :: Int -> Position -> ShowS
Show, 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)

-- | The initial 'Position' for the start of a file
startPos :: Position
startPos :: Position
startPos = $WPosition :: Int -> Int -> Int -> Position
Position { posIndex :: Int
posIndex = 0, posLine :: Int
posLine = 1, posColumn :: Int
posColumn = 1 }

-- | A value annotated with its text file position
data Located a = Located
  { Located a -> Position
locPosition :: {-# UNPACK #-} !Position
  , Located a -> a
locThing    :: !a
  }
  deriving (ReadPrec [Located a]
ReadPrec (Located a)
Int -> ReadS (Located a)
ReadS [Located a]
(Int -> ReadS (Located a))
-> ReadS [Located a]
-> ReadPrec (Located a)
-> ReadPrec [Located a]
-> Read (Located a)
forall a. Read a => ReadPrec [Located a]
forall a. Read a => ReadPrec (Located a)
forall a. Read a => Int -> ReadS (Located a)
forall a. Read a => ReadS [Located a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Located a]
$creadListPrec :: forall a. Read a => ReadPrec [Located a]
readPrec :: ReadPrec (Located a)
$creadPrec :: forall a. Read a => ReadPrec (Located a)
readList :: ReadS [Located a]
$creadList :: forall a. Read a => ReadS [Located a]
readsPrec :: Int -> ReadS (Located a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Located a)
Read, Int -> Located a -> ShowS
[Located a] -> ShowS
Located a -> String
(Int -> Located a -> ShowS)
-> (Located a -> String)
-> ([Located a] -> ShowS)
-> Show (Located a)
forall a. Show a => Int -> Located a -> ShowS
forall a. Show a => [Located a] -> ShowS
forall a. Show a => Located a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Located a] -> ShowS
$cshowList :: forall a. Show a => [Located a] -> ShowS
show :: Located a -> String
$cshow :: forall a. Show a => Located a -> String
showsPrec :: Int -> Located a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Located a -> ShowS
Show)

instance Functor Located where
  fmap :: (a -> b) -> Located a -> Located b
fmap f :: a -> b
f (Located p :: Position
p x :: a
x) = Position -> b -> Located b
forall a. Position -> a -> Located a
Located Position
p (a -> b
f a
x)

-- | The token type used by "Config.Lexer" and "Config.Parser"
data Token
  = Section Text
  | String Text
  | Atom Text
  | Bullet
  | Comma
  | Number Number
  | OpenList
  | CloseList
  | OpenMap
  | CloseMap

  | Error Error

  -- "Virtual" tokens used by the subsequent layout processor
  | LayoutSep
  | LayoutEnd
  | EOF
  deriving (Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show)

-- | Types of lexical errors
data Error
  = UntermComment
  | UntermString
  | UntermList
  | UntermSections
  | BadEscape Text
  | NoMatch Char
  deriving (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show)

-- | Process a list of position-annotated tokens inserting
-- layout end tokens as appropriate.
layoutPass ::
  [Located Token] {- ^ tokens without layout markers -} ->
  [Located Token] {- ^ tokens with    layout markers -}
layoutPass :: [Located Token] -> [Located Token]
layoutPass toks :: [Located Token]
toks = (Located Token
 -> ([Layout] -> [Located Token]) -> [Layout] -> [Located Token])
-> ([Layout] -> [Located Token])
-> [Located Token]
-> [Layout]
-> [Located Token]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Located Token
-> ([Layout] -> [Located Token]) -> [Layout] -> [Located Token]
step (\_ -> []) [Located Token]
toks [Int -> Layout
Layout (-1)]

data Layout = NoLayout | Layout Int

-- | Single step of the layout pass
step ::
  Located Token                 {- ^ current token            -} ->
  ([Layout] -> [Located Token]) {- ^ continuation             -} ->
  [Layout]                      {- ^ stack of layout scopes   -} ->
  [Located Token]               {- ^ token stream with layout -}

-- start blocks must be indented
-- tokens before the current layout end the current layout
-- note that EOF occurs on column 1 for properly formatted text files
step :: Located Token
-> ([Layout] -> [Located Token]) -> [Layout] -> [Located Token]
step t :: Located Token
t next :: [Layout] -> [Located Token]
next cols :: [Layout]
cols =
  case [Layout]
cols of
    NoLayout:cols' :: [Layout]
cols' | Token
CloseMap <- Located Token -> Token
forall a. Located a -> a
locThing Located Token
t -> Located Token
t Located Token -> [Located Token] -> [Located Token]
forall a. a -> [a] -> [a]
: [Layout] -> [Located Token]
next [Layout]
cols'
    _              | Token
OpenMap  <- Located Token -> Token
forall a. Located a -> a
locThing Located Token
t -> Located Token
t Located Token -> [Located Token] -> [Located Token]
forall a. a -> [a] -> [a]
: [Layout] -> [Located Token]
next (Layout
NoLayout Layout -> [Layout] -> [Layout]
forall a. a -> [a] -> [a]
: [Layout]
cols)
    Layout col :: Int
col:_     | Located Token -> Int
forall a. Located a -> Int
toCol Located Token
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
col -> Located Token
t{locThing :: Token
locThing=Token
LayoutSep} Located Token -> [Located Token] -> [Located Token]
forall a. a -> [a] -> [a]
: Located Token
t Located Token -> [Located Token] -> [Located Token]
forall a. a -> [a] -> [a]
: [Layout] -> [Located Token]
next [Layout]
cols
    Layout col :: Int
col:cols' :: [Layout]
cols' | Located Token -> Int
forall a. Located a -> Int
toCol Located Token
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
col -> Located Token
t{locThing :: Token
locThing=Token
LayoutEnd} Located Token -> [Located Token] -> [Located Token]
forall a. a -> [a] -> [a]
: Located Token
-> ([Layout] -> [Located Token]) -> [Layout] -> [Located Token]
step Located Token
t [Layout] -> [Located Token]
next [Layout]
cols'
    Layout{}:_       | Located Token -> Bool
usesLayout Located Token
t   -> Located Token
t Located Token -> [Located Token] -> [Located Token]
forall a. a -> [a] -> [a]
: [Layout] -> [Located Token]
next (Int -> Layout
Layout (Located Token -> Int
forall a. Located a -> Int
toCol Located Token
t) Layout -> [Layout] -> [Layout]
forall a. a -> [a] -> [a]
: [Layout]
cols)
    _                                 -> Located Token
t Located Token -> [Located Token] -> [Located Token]
forall a. a -> [a] -> [a]
: [Layout] -> [Located Token]
next [Layout]
cols

-- | Extract the column number from a located thing.
toCol :: Located a -> Int
toCol :: Located a -> Int
toCol = Position -> Int
posColumn (Position -> Int) -> (Located a -> Position) -> Located a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located a -> Position
forall a. Located a -> Position
locPosition


-- | Return True when a token starts a layout scope.
usesLayout :: Located Token -> Bool
usesLayout :: Located Token -> Bool
usesLayout t :: Located Token
t
  | Section{} <- Located Token -> Token
forall a. Located a -> a
locThing Located Token
t = Bool
True
  | Token
Bullet    <- Located Token -> Token
forall a. Located a -> a
locThing Located Token
t = Bool
True
  | Bool
otherwise               = Bool
False