{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE ViewPatterns          #-}
-- | Common token representation used.
module Token(MyTok(..), MyLoc(..), Tokenized, line, col, mark, unwrap, unTikzMark) where

import           Data.Text(Text)
import qualified Data.Text as T
import           Optics.TH ( makeLenses )

-- * Common tokens and locations
--   We keep them here, so we can translate output from tokenizers to common format.
-- | Location is just line and column (not a slice.)
data MyLoc = MyLoc { MyLoc -> Int
_line :: Int  -- ^ Line number starting from 1
                   , MyLoc -> Int
_col  :: Int  -- ^ Column number starting from 1
                   , MyLoc -> Bool
_mark :: Bool -- ^ Is this a valid indent mark?
                   }
  deriving (MyLoc -> MyLoc -> Bool
(MyLoc -> MyLoc -> Bool) -> (MyLoc -> MyLoc -> Bool) -> Eq MyLoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MyLoc -> MyLoc -> Bool
== :: MyLoc -> MyLoc -> Bool
$c/= :: MyLoc -> MyLoc -> Bool
/= :: MyLoc -> MyLoc -> Bool
Eq, Eq MyLoc
Eq MyLoc =>
(MyLoc -> MyLoc -> Ordering)
-> (MyLoc -> MyLoc -> Bool)
-> (MyLoc -> MyLoc -> Bool)
-> (MyLoc -> MyLoc -> Bool)
-> (MyLoc -> MyLoc -> Bool)
-> (MyLoc -> MyLoc -> MyLoc)
-> (MyLoc -> MyLoc -> MyLoc)
-> Ord MyLoc
MyLoc -> MyLoc -> Bool
MyLoc -> MyLoc -> Ordering
MyLoc -> MyLoc -> MyLoc
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
$ccompare :: MyLoc -> MyLoc -> Ordering
compare :: MyLoc -> MyLoc -> Ordering
$c< :: MyLoc -> MyLoc -> Bool
< :: MyLoc -> MyLoc -> Bool
$c<= :: MyLoc -> MyLoc -> Bool
<= :: MyLoc -> MyLoc -> Bool
$c> :: MyLoc -> MyLoc -> Bool
> :: MyLoc -> MyLoc -> Bool
$c>= :: MyLoc -> MyLoc -> Bool
>= :: MyLoc -> MyLoc -> Bool
$cmax :: MyLoc -> MyLoc -> MyLoc
max :: MyLoc -> MyLoc -> MyLoc
$cmin :: MyLoc -> MyLoc -> MyLoc
min :: MyLoc -> MyLoc -> MyLoc
Ord, Int -> MyLoc -> ShowS
[MyLoc] -> ShowS
MyLoc -> String
(Int -> MyLoc -> ShowS)
-> (MyLoc -> String) -> ([MyLoc] -> ShowS) -> Show MyLoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MyLoc -> ShowS
showsPrec :: Int -> MyLoc -> ShowS
$cshow :: MyLoc -> String
show :: MyLoc -> String
$cshowList :: [MyLoc] -> ShowS
showList :: [MyLoc] -> ShowS
Show)

makeLenses ''MyLoc

-- | Token just classifies to blank, operator, and the style class
data MyTok =
    TBlank      -- ^ Whitespace or comments
  | TOperator   -- ^ Operators
  | TKeyword    -- ^ Language-specific keywords
  | TCons       -- ^ Constructors
  | TVar        -- ^ Variables, function names
  | TNum        -- ^ Numbers
  | TOther      -- ^ Other tokens
  | TString     -- ^ String constants
  | TTikz  Text -- ^ TikZmark in a comment
  deriving (MyTok -> MyTok -> Bool
(MyTok -> MyTok -> Bool) -> (MyTok -> MyTok -> Bool) -> Eq MyTok
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MyTok -> MyTok -> Bool
== :: MyTok -> MyTok -> Bool
$c/= :: MyTok -> MyTok -> Bool
/= :: MyTok -> MyTok -> Bool
Eq, Eq MyTok
Eq MyTok =>
(MyTok -> MyTok -> Ordering)
-> (MyTok -> MyTok -> Bool)
-> (MyTok -> MyTok -> Bool)
-> (MyTok -> MyTok -> Bool)
-> (MyTok -> MyTok -> Bool)
-> (MyTok -> MyTok -> MyTok)
-> (MyTok -> MyTok -> MyTok)
-> Ord MyTok
MyTok -> MyTok -> Bool
MyTok -> MyTok -> Ordering
MyTok -> MyTok -> MyTok
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
$ccompare :: MyTok -> MyTok -> Ordering
compare :: MyTok -> MyTok -> Ordering
$c< :: MyTok -> MyTok -> Bool
< :: MyTok -> MyTok -> Bool
$c<= :: MyTok -> MyTok -> Bool
<= :: MyTok -> MyTok -> Bool
$c> :: MyTok -> MyTok -> Bool
> :: MyTok -> MyTok -> Bool
$c>= :: MyTok -> MyTok -> Bool
>= :: MyTok -> MyTok -> Bool
$cmax :: MyTok -> MyTok -> MyTok
max :: MyTok -> MyTok -> MyTok
$cmin :: MyTok -> MyTok -> MyTok
min :: MyTok -> MyTok -> MyTok
Ord, Int -> MyTok -> ShowS
[MyTok] -> ShowS
MyTok -> String
(Int -> MyTok -> ShowS)
-> (MyTok -> String) -> ([MyTok] -> ShowS) -> Show MyTok
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MyTok -> ShowS
showsPrec :: Int -> MyTok -> ShowS
$cshow :: MyTok -> String
show :: MyTok -> String
$cshowList :: [MyTok] -> ShowS
showList :: [MyTok] -> ShowS
Show)

-- | Records tokenized and converted to common token format.
type Tokenized = (MyTok -- Token type
                 ,MyLoc -- Starting location for the token
                 ,Text  -- text value of the token
                 )

-- | Unpack a Haskell comment with a TikZ mark indicator.
unTikzMark    :: Text -> Maybe Text
unTikzMark :: Text -> Maybe Text
unTikzMark Text
txt =
  Text -> Text -> Text -> Maybe Text
unwrap Text
"{->" Text
"-}" Text
txt Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Text
""    -> Maybe Text
forall a. Maybe a
Nothing
    Text
aMark -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
aMark

-- | Given opening text, and closing text,
--   check that input is "braced" by these, and strip them.
--   Return `Nothing` if input text does not match.
unwrap :: Text -- ^ Opening text
       -> Text -- ^ Closing text
       -> Text -- ^ Input to match
       -> Maybe Text
unwrap :: Text -> Text -> Text -> Maybe Text
unwrap Text
starter Text
trailer   Text
txt  |
  Text
starter Text -> Text -> Bool
`T.isPrefixOf` Text
txt Bool -> Bool -> Bool
&&
  Text
trailer Text -> Text -> Bool
`T.isPrefixOf` Text
txt  =
      Text -> Maybe Text
forall a. a -> Maybe a
Just
    (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.dropEnd (Text -> Int
T.length Text
trailer)
    (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop    (Text -> Int
T.length Text
starter) Text
txt
unwrap Text
_       Text
_         Text
_    = Maybe Text
forall a. Maybe a
Nothing