------------------------------------------------------------------------------
-- |
-- Module      : QueueSheet.Types
-- Description : queue sheet types
-- Copyright   : Copyright (c) 2020-2022 Travis Cardwell
-- License     : MIT
------------------------------------------------------------------------------

{-# LANGUAGE CPP #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}

module QueueSheet.Types
  ( -- * Name
    Name(..)
    -- * Url
  , Url(..)
    -- * Date
  , Date(..)
    -- * Section
  , Section(..)
  , defaultSection
    -- * Tag
  , Tag(..)
    -- * Item
  , Item(..)
    -- * Queue
  , Queue(..)
    -- * Import
  , Import(..)
    -- * ImportOrQueue
  , ImportOrQueue(..)
    -- * QueuesFile
  , QueuesFile(..)
    -- * QueueSheet
  , QueueSheet(..)
  ) where

-- https://hackage.haskell.org/package/aeson
import qualified Data.Aeson as A
import Data.Aeson (FromJSON(parseJSON), (.:), (.:?), (.!=))
import qualified Data.Aeson.Types as AT

-- https://hackage.haskell.org/package/base
import Control.Applicative ((<|>))
import Control.Monad (unless, when)
import Data.Char (isAsciiLower, isAsciiUpper, isDigit)
#if !MIN_VERSION_base (4,11,0)
import Data.Monoid ((<>))
#endif

-- https://hackage.haskell.org/package/ginger
import qualified Text.Ginger as Ginger
import Text.Ginger ((~>))

-- https://hackage.haskell.org/package/scientific
import qualified Data.Scientific as Sci

-- https://hackage.haskell.org/package/text
import qualified Data.Text as T
import Data.Text (Text)

-- https://hackage.haskell.org/package/ttc
import qualified Data.TTC as TTC

-- https://hackage.haskell.org/package/vector
import qualified Data.Vector as V

------------------------------------------------------------------------------
-- $Name

-- | Name of a queue or queue item
--
-- @since 0.3.0.0
newtype Name = Name Text
  deriving newtype (Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show)

instance FromJSON Name where
  parseJSON :: Value -> Parser Name
parseJSON = (Text -> Name) -> Parser Text -> Parser Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Name
Name (Parser Text -> Parser Name)
-> (Value -> Parser Text) -> Value -> Parser Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Text
parseToString

instance Ginger.ToGVal m Name where
  toGVal :: Name -> GVal m
toGVal (Name Text
t) = Text -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
Ginger.toGVal (Text -> GVal m) -> Text -> GVal m
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeTeX Text
t

instance TTC.Render Name where
  render :: Name -> t
render (Name Text
t) = Text -> t
forall t. Textual t => Text -> t
TTC.fromT Text
t

------------------------------------------------------------------------------
-- $Url

-- | URL of queue or queue item
--
-- @since 0.3.0.0
newtype Url = Url Text
  deriving newtype (Url -> Url -> Bool
(Url -> Url -> Bool) -> (Url -> Url -> Bool) -> Eq Url
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Url -> Url -> Bool
$c/= :: Url -> Url -> Bool
== :: Url -> Url -> Bool
$c== :: Url -> Url -> Bool
Eq, Int -> Url -> ShowS
[Url] -> ShowS
Url -> String
(Int -> Url -> ShowS)
-> (Url -> String) -> ([Url] -> ShowS) -> Show Url
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Url] -> ShowS
$cshowList :: [Url] -> ShowS
show :: Url -> String
$cshow :: Url -> String
showsPrec :: Int -> Url -> ShowS
$cshowsPrec :: Int -> Url -> ShowS
Show)

instance FromJSON Url where
  parseJSON :: Value -> Parser Url
parseJSON = (Text -> Url) -> Parser Text -> Parser Url
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Url
Url (Parser Text -> Parser Url)
-> (Value -> Parser Text) -> Value -> Parser Url
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Text
parseToString

instance Ginger.ToGVal m Url where
  toGVal :: Url -> GVal m
toGVal (Url Text
t) = Text -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
Ginger.toGVal (Text -> GVal m) -> Text -> GVal m
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeTeX Text
t

instance TTC.Render Url where
  render :: Url -> t
render (Url Text
t) = Text -> t
forall t. Textual t => Text -> t
TTC.fromT Text
t

------------------------------------------------------------------------------
-- $Date

-- | Date of last queue update
--
-- @since 0.3.0.0
newtype Date = Date Text
  deriving newtype (Date -> Date -> Bool
(Date -> Date -> Bool) -> (Date -> Date -> Bool) -> Eq Date
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Date -> Date -> Bool
$c/= :: Date -> Date -> Bool
== :: Date -> Date -> Bool
$c== :: Date -> Date -> Bool
Eq, Int -> Date -> ShowS
[Date] -> ShowS
Date -> String
(Int -> Date -> ShowS)
-> (Date -> String) -> ([Date] -> ShowS) -> Show Date
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Date] -> ShowS
$cshowList :: [Date] -> ShowS
show :: Date -> String
$cshow :: Date -> String
showsPrec :: Int -> Date -> ShowS
$cshowsPrec :: Int -> Date -> ShowS
Show)

instance FromJSON Date where
  parseJSON :: Value -> Parser Date
parseJSON = (Text -> Date) -> Parser Text -> Parser Date
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Date
Date (Parser Text -> Parser Date)
-> (Value -> Parser Text) -> Value -> Parser Date
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Text
parseToString

instance Ginger.ToGVal m Date where
  toGVal :: Date -> GVal m
toGVal (Date Text
t) = Text -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
Ginger.toGVal (Text -> GVal m) -> Text -> GVal m
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeTeX Text
t

instance TTC.Render Date where
  render :: Date -> t
render (Date Text
t) = Text -> t
forall t. Textual t => Text -> t
TTC.fromT Text
t

------------------------------------------------------------------------------
-- $Section

-- | Section used to organize queues
--
-- @since 0.3.0.0
newtype Section = Section Text
  deriving newtype (Section -> Section -> Bool
(Section -> Section -> Bool)
-> (Section -> Section -> Bool) -> Eq Section
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Section -> Section -> Bool
$c/= :: Section -> Section -> Bool
== :: Section -> Section -> Bool
$c== :: Section -> Section -> Bool
Eq, Int -> Section -> ShowS
[Section] -> ShowS
Section -> String
(Int -> Section -> ShowS)
-> (Section -> String) -> ([Section] -> ShowS) -> Show Section
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Section] -> ShowS
$cshowList :: [Section] -> ShowS
show :: Section -> String
$cshow :: Section -> String
showsPrec :: Int -> Section -> ShowS
$cshowsPrec :: Int -> Section -> ShowS
Show)

instance FromJSON Section where
  parseJSON :: Value -> Parser Section
parseJSON = (Text -> Section) -> Parser Text -> Parser Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Section
Section (Parser Text -> Parser Section)
-> (Value -> Parser Text) -> Value -> Parser Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Text
parseToString

instance Ginger.ToGVal m Section where
  toGVal :: Section -> GVal m
toGVal (Section Text
t) = Text -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
Ginger.toGVal (Text -> GVal m) -> Text -> GVal m
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeTeX Text
t

instance TTC.Render Section where
  render :: Section -> t
render (Section Text
t) = Text -> t
forall t. Textual t => Text -> t
TTC.fromT Text
t

-- | The default section is represented as an empty string
defaultSection :: Section
defaultSection :: Section
defaultSection = Text -> Section
Section Text
""

------------------------------------------------------------------------------
-- $Tag

-- | Queue tag
--
-- @since 0.3.0.0
newtype Tag = Tag Text
  deriving newtype (Tag -> Tag -> Bool
(Tag -> Tag -> Bool) -> (Tag -> Tag -> Bool) -> Eq Tag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c== :: Tag -> Tag -> Bool
Eq, Int -> Tag -> ShowS
[Tag] -> ShowS
Tag -> String
(Int -> Tag -> ShowS)
-> (Tag -> String) -> ([Tag] -> ShowS) -> Show Tag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tag] -> ShowS
$cshowList :: [Tag] -> ShowS
show :: Tag -> String
$cshow :: Tag -> String
showsPrec :: Int -> Tag -> ShowS
$cshowsPrec :: Int -> Tag -> ShowS
Show)

instance FromJSON Tag where
  parseJSON :: Value -> Parser Tag
parseJSON = String -> (Text -> Parser Tag) -> Value -> Parser Tag
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"Tag" ((Text -> Parser Tag) -> Value -> Parser Tag)
-> (Text -> Parser Tag) -> Value -> Parser Tag
forall a b. (a -> b) -> a -> b
$ \Text
t -> do
      Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
T.null Text
t) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty tag"
      Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isValidChar Text
t) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid tag: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t)
      Tag -> Parser Tag
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag -> Parser Tag) -> Tag -> Parser Tag
forall a b. (a -> b) -> a -> b
$ Text -> Tag
Tag Text
t
    where
      isValidChar :: Char -> Bool
      isValidChar :: Char -> Bool
isValidChar Char
c
        | Char -> Bool
isAsciiLower Char
c = Bool
True
        | Char -> Bool
isAsciiUpper Char
c = Bool
True
        | Char -> Bool
isDigit      Char
c = Bool
True
        | Bool
otherwise      = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"._-" :: String)

------------------------------------------------------------------------------
-- $Item

-- | Queue item
--
-- @since 0.5.0.0
data Item
  = Item
    { Item -> Name
itemName :: !Name
    , Item -> Maybe Url
itemUrl  :: !(Maybe Url)
    , Item -> [Tag]
itemTags :: ![Tag]
    }
  deriving (Item -> Item -> Bool
(Item -> Item -> Bool) -> (Item -> Item -> Bool) -> Eq Item
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Item -> Item -> Bool
$c/= :: Item -> Item -> Bool
== :: Item -> Item -> Bool
$c== :: Item -> Item -> Bool
Eq, Int -> Item -> ShowS
[Item] -> ShowS
Item -> String
(Int -> Item -> ShowS)
-> (Item -> String) -> ([Item] -> ShowS) -> Show Item
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Item] -> ShowS
$cshowList :: [Item] -> ShowS
show :: Item -> String
$cshow :: Item -> String
showsPrec :: Int -> Item -> ShowS
$cshowsPrec :: Int -> Item -> ShowS
Show)

instance FromJSON Item where
  parseJSON :: Value -> Parser Item
parseJSON = \case
    (A.Object Object
o) -> do
      Name
itemName <- Object
o Object -> Key -> Parser Name
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"name"
      Maybe Url
itemUrl  <- Object
o Object -> Key -> Parser (Maybe Url)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url"
      [Tag]
itemTags <- Parser [Tag]
-> (Value -> Parser [Tag]) -> Maybe Value -> Parser [Tag]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Tag] -> Parser [Tag]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) Value -> Parser [Tag]
forall a. FromJSON a => Value -> Parser [a]
parseCSV (Maybe Value -> Parser [Tag])
-> Parser (Maybe Value) -> Parser [Tag]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tags")
      Item -> Parser Item
forall (m :: * -> *) a. Monad m => a -> m a
return Item :: Name -> Maybe Url -> [Tag] -> Item
Item{[Tag]
Maybe Url
Name
itemTags :: [Tag]
itemUrl :: Maybe Url
itemName :: Name
itemTags :: [Tag]
itemUrl :: Maybe Url
itemName :: Name
..}
    Value
value -> do
      Name
itemName <- Text -> Name
Name (Text -> Name) -> Parser Text -> Parser Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
parseToString Value
value
      let itemUrl :: Maybe a
itemUrl  = Maybe a
forall a. Maybe a
Nothing
          itemTags :: [a]
itemTags = []
      Item -> Parser Item
forall (m :: * -> *) a. Monad m => a -> m a
return Item :: Name -> Maybe Url -> [Tag] -> Item
Item{[Tag]
Maybe Url
Name
forall a. [a]
forall a. Maybe a
itemTags :: forall a. [a]
itemUrl :: forall a. Maybe a
itemName :: Name
itemTags :: [Tag]
itemUrl :: Maybe Url
itemName :: Name
..}

instance Ginger.ToGVal m Item where
  toGVal :: Item -> GVal m
toGVal Item{[Tag]
Maybe Url
Name
itemTags :: [Tag]
itemUrl :: Maybe Url
itemName :: Name
itemTags :: Item -> [Tag]
itemUrl :: Item -> Maybe Url
itemName :: Item -> Name
..} = [Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
Ginger.dict ([Pair m] -> GVal m) -> [Pair m] -> GVal m
forall a b. (a -> b) -> a -> b
$
    [ Text
"name" Text -> Name -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Name
itemName
    , Text
"url"  Text -> Maybe Url -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Maybe Url
itemUrl
    ] [Pair m] -> [Pair m] -> [Pair m]
forall a. [a] -> [a] -> [a]
++ [(Text
"tag_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tag) Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Bool
True | Tag Text
tag <- [Tag]
itemTags]

------------------------------------------------------------------------------
-- $Queue

-- | Queue information
--
-- @since 0.5.0.0
data Queue
  = Queue
    { Queue -> Name
queueName    :: !Name
    , Queue -> Maybe Url
queueUrl     :: !(Maybe Url)
    , Queue -> Maybe Date
queueDate    :: !(Maybe Date)
    , Queue -> Section
queueSection :: !Section
    , Queue -> [Tag]
queueTags    :: ![Tag]
    , Queue -> Maybe (Either Item [Item])
queueItems   :: !(Maybe (Either Item [Item]))
    }
  deriving (Queue -> Queue -> Bool
(Queue -> Queue -> Bool) -> (Queue -> Queue -> Bool) -> Eq Queue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Queue -> Queue -> Bool
$c/= :: Queue -> Queue -> Bool
== :: Queue -> Queue -> Bool
$c== :: Queue -> Queue -> Bool
Eq, Int -> Queue -> ShowS
[Queue] -> ShowS
Queue -> String
(Int -> Queue -> ShowS)
-> (Queue -> String) -> ([Queue] -> ShowS) -> Show Queue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Queue] -> ShowS
$cshowList :: [Queue] -> ShowS
show :: Queue -> String
$cshow :: Queue -> String
showsPrec :: Int -> Queue -> ShowS
$cshowsPrec :: Int -> Queue -> ShowS
Show)

instance FromJSON Queue where
  parseJSON :: Value -> Parser Queue
parseJSON = String -> (Object -> Parser Queue) -> Value -> Parser Queue
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Queue" ((Object -> Parser Queue) -> Value -> Parser Queue)
-> (Object -> Parser Queue) -> Value -> Parser Queue
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Name
queueName    <- Object
o Object -> Key -> Parser Name
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"name"
    Maybe Url
queueUrl     <- Object
o Object -> Key -> Parser (Maybe Url)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url"
    Maybe Date
queueDate    <- Object
o Object -> Key -> Parser (Maybe Date)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"date"
    Section
queueSection <- Object
o Object -> Key -> Parser (Maybe Section)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"section" Parser (Maybe Section) -> Section -> Parser Section
forall a. Parser (Maybe a) -> a -> Parser a
.!= Section
defaultSection
    [Tag]
queueTags    <- Parser [Tag]
-> (Value -> Parser [Tag]) -> Maybe Value -> Parser [Tag]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Tag] -> Parser [Tag]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) Value -> Parser [Tag]
forall a. FromJSON a => Value -> Parser [a]
parseCSV (Maybe Value -> Parser [Tag])
-> Parser (Maybe Value) -> Parser [Tag]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tags")
    Maybe Item
mPrevItem    <- Object
o Object -> Key -> Parser (Maybe Item)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prev"
    Maybe Value
mNextValue   <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"next"
    Maybe (Either Item [Item])
queueItems   <- case (Maybe Item
mPrevItem, Maybe Value
mNextValue) of
      (Maybe Item
_,         Just Value
nextValue) -> Either Item [Item] -> Maybe (Either Item [Item])
forall a. a -> Maybe a
Just (Either Item [Item] -> Maybe (Either Item [Item]))
-> ([Item] -> Either Item [Item])
-> [Item]
-> Maybe (Either Item [Item])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item] -> Either Item [Item]
forall a b. b -> Either a b
Right ([Item] -> Maybe (Either Item [Item]))
-> Parser [Item] -> Parser (Maybe (Either Item [Item]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [Item]
forall a. FromJSON a => Value -> Parser [a]
parseCSV Value
nextValue
      (Just Item
item, Maybe Value
Nothing)        -> Maybe (Either Item [Item]) -> Parser (Maybe (Either Item [Item]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Either Item [Item]) -> Parser (Maybe (Either Item [Item])))
-> (Either Item [Item] -> Maybe (Either Item [Item]))
-> Either Item [Item]
-> Parser (Maybe (Either Item [Item]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Item [Item] -> Maybe (Either Item [Item])
forall a. a -> Maybe a
Just (Either Item [Item] -> Parser (Maybe (Either Item [Item])))
-> Either Item [Item] -> Parser (Maybe (Either Item [Item]))
forall a b. (a -> b) -> a -> b
$ Item -> Either Item [Item]
forall a b. a -> Either a b
Left Item
item
      (Maybe Item
Nothing,   Maybe Value
Nothing)        -> Maybe (Either Item [Item]) -> Parser (Maybe (Either Item [Item]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Either Item [Item])
forall a. Maybe a
Nothing
    Queue -> Parser Queue
forall (m :: * -> *) a. Monad m => a -> m a
return Queue :: Name
-> Maybe Url
-> Maybe Date
-> Section
-> [Tag]
-> Maybe (Either Item [Item])
-> Queue
Queue{[Tag]
Maybe (Either Item [Item])
Maybe Date
Maybe Url
Section
Name
queueItems :: Maybe (Either Item [Item])
queueTags :: [Tag]
queueSection :: Section
queueDate :: Maybe Date
queueUrl :: Maybe Url
queueName :: Name
queueItems :: Maybe (Either Item [Item])
queueTags :: [Tag]
queueSection :: Section
queueDate :: Maybe Date
queueUrl :: Maybe Url
queueName :: Name
..}

------------------------------------------------------------------------------
-- $Import

-- | Import declaration
--
-- @since 0.3.0.0
data Import
  = Import
    { Import -> String
importPath    :: !FilePath
    , Import -> Maybe Section
importSection :: !(Maybe Section)
    }
  deriving (Import -> Import -> Bool
(Import -> Import -> Bool)
-> (Import -> Import -> Bool) -> Eq Import
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Import -> Import -> Bool
$c/= :: Import -> Import -> Bool
== :: Import -> Import -> Bool
$c== :: Import -> Import -> Bool
Eq, Int -> Import -> ShowS
[Import] -> ShowS
Import -> String
(Int -> Import -> ShowS)
-> (Import -> String) -> ([Import] -> ShowS) -> Show Import
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Import] -> ShowS
$cshowList :: [Import] -> ShowS
show :: Import -> String
$cshow :: Import -> String
showsPrec :: Int -> Import -> ShowS
$cshowsPrec :: Int -> Import -> ShowS
Show)

instance FromJSON Import where
  parseJSON :: Value -> Parser Import
parseJSON = String -> (Object -> Parser Import) -> Value -> Parser Import
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Import" ((Object -> Parser Import) -> Value -> Parser Import)
-> (Object -> Parser Import) -> Value -> Parser Import
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    String
importPath    <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"import"
    Maybe Section
importSection <- Object
o Object -> Key -> Parser (Maybe Section)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"section"
    Import -> Parser Import
forall (m :: * -> *) a. Monad m => a -> m a
return Import :: String -> Maybe Section -> Import
Import{String
Maybe Section
importSection :: Maybe Section
importPath :: String
importSection :: Maybe Section
importPath :: String
..}

------------------------------------------------------------------------------
-- $ImportOrQueue

-- | Import declaration or queue information
--
-- @since 0.3.0.0
data ImportOrQueue
  = IQImport !Import
  | IQQueue  !Queue
  deriving (ImportOrQueue -> ImportOrQueue -> Bool
(ImportOrQueue -> ImportOrQueue -> Bool)
-> (ImportOrQueue -> ImportOrQueue -> Bool) -> Eq ImportOrQueue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportOrQueue -> ImportOrQueue -> Bool
$c/= :: ImportOrQueue -> ImportOrQueue -> Bool
== :: ImportOrQueue -> ImportOrQueue -> Bool
$c== :: ImportOrQueue -> ImportOrQueue -> Bool
Eq, Int -> ImportOrQueue -> ShowS
[ImportOrQueue] -> ShowS
ImportOrQueue -> String
(Int -> ImportOrQueue -> ShowS)
-> (ImportOrQueue -> String)
-> ([ImportOrQueue] -> ShowS)
-> Show ImportOrQueue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportOrQueue] -> ShowS
$cshowList :: [ImportOrQueue] -> ShowS
show :: ImportOrQueue -> String
$cshow :: ImportOrQueue -> String
showsPrec :: Int -> ImportOrQueue -> ShowS
$cshowsPrec :: Int -> ImportOrQueue -> ShowS
Show)

instance FromJSON ImportOrQueue where
  parseJSON :: Value -> Parser ImportOrQueue
parseJSON Value
value =
    (Import -> ImportOrQueue
IQImport (Import -> ImportOrQueue) -> Parser Import -> Parser ImportOrQueue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Import
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value) Parser ImportOrQueue
-> Parser ImportOrQueue -> Parser ImportOrQueue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Queue -> ImportOrQueue
IQQueue (Queue -> ImportOrQueue) -> Parser Queue -> Parser ImportOrQueue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Queue
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value)

------------------------------------------------------------------------------
-- $QueuesFile

-- | Queues file
--
-- @since 0.3.0.0
data QueuesFile
  = QueuesFile
    { QueuesFile -> [Section]
qfSections       :: ![Section]
    , QueuesFile -> [ImportOrQueue]
qfImportOrQueues :: ![ImportOrQueue]
    }
  deriving (QueuesFile -> QueuesFile -> Bool
(QueuesFile -> QueuesFile -> Bool)
-> (QueuesFile -> QueuesFile -> Bool) -> Eq QueuesFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueuesFile -> QueuesFile -> Bool
$c/= :: QueuesFile -> QueuesFile -> Bool
== :: QueuesFile -> QueuesFile -> Bool
$c== :: QueuesFile -> QueuesFile -> Bool
Eq, Int -> QueuesFile -> ShowS
[QueuesFile] -> ShowS
QueuesFile -> String
(Int -> QueuesFile -> ShowS)
-> (QueuesFile -> String)
-> ([QueuesFile] -> ShowS)
-> Show QueuesFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueuesFile] -> ShowS
$cshowList :: [QueuesFile] -> ShowS
show :: QueuesFile -> String
$cshow :: QueuesFile -> String
showsPrec :: Int -> QueuesFile -> ShowS
$cshowsPrec :: Int -> QueuesFile -> ShowS
Show)

instance FromJSON QueuesFile where
  parseJSON :: Value -> Parser QueuesFile
parseJSON = \case
    (A.Object Object
o) -> do
      [Section]
qfSections <- (:) Section
defaultSection ([Section] -> [Section]) -> Parser [Section] -> Parser [Section]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Section])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sections" Parser (Maybe [Section]) -> [Section] -> Parser [Section]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [])
      [ImportOrQueue]
qfImportOrQueues <- Object
o Object -> Key -> Parser [ImportOrQueue]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"queues"
      QueuesFile -> Parser QueuesFile
forall (m :: * -> *) a. Monad m => a -> m a
return QueuesFile :: [Section] -> [ImportOrQueue] -> QueuesFile
QueuesFile{[ImportOrQueue]
[Section]
qfImportOrQueues :: [ImportOrQueue]
qfSections :: [Section]
qfImportOrQueues :: [ImportOrQueue]
qfSections :: [Section]
..}
    a :: Value
a@A.Array{} -> do
      let qfSections :: [Section]
qfSections = [Section
defaultSection]
      [ImportOrQueue]
qfImportOrQueues <- Value -> Parser [ImportOrQueue]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
a
      QueuesFile -> Parser QueuesFile
forall (m :: * -> *) a. Monad m => a -> m a
return QueuesFile :: [Section] -> [ImportOrQueue] -> QueuesFile
QueuesFile{[ImportOrQueue]
[Section]
qfImportOrQueues :: [ImportOrQueue]
qfSections :: [Section]
qfImportOrQueues :: [ImportOrQueue]
qfSections :: [Section]
..}
    A.String{} -> String -> Parser QueuesFile
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected string"
    A.Number{} -> String -> Parser QueuesFile
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected number"
    A.Bool{}   -> String -> Parser QueuesFile
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected bool"
    Value
A.Null     -> String -> Parser QueuesFile
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected null"

------------------------------------------------------------------------------
-- $QueueSheet

-- | Queue sheet
--
-- @since 0.3.0.0
data QueueSheet
  = QueueSheet
    { QueueSheet -> [Section]
qsSections :: ![Section]
    , QueueSheet -> [Queue]
qsQueues   :: ![Queue]
    }
  deriving (QueueSheet -> QueueSheet -> Bool
(QueueSheet -> QueueSheet -> Bool)
-> (QueueSheet -> QueueSheet -> Bool) -> Eq QueueSheet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueueSheet -> QueueSheet -> Bool
$c/= :: QueueSheet -> QueueSheet -> Bool
== :: QueueSheet -> QueueSheet -> Bool
$c== :: QueueSheet -> QueueSheet -> Bool
Eq, Int -> QueueSheet -> ShowS
[QueueSheet] -> ShowS
QueueSheet -> String
(Int -> QueueSheet -> ShowS)
-> (QueueSheet -> String)
-> ([QueueSheet] -> ShowS)
-> Show QueueSheet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueueSheet] -> ShowS
$cshowList :: [QueueSheet] -> ShowS
show :: QueueSheet -> String
$cshow :: QueueSheet -> String
showsPrec :: Int -> QueueSheet -> ShowS
$cshowsPrec :: Int -> QueueSheet -> ShowS
Show)

------------------------------------------------------------------------------
-- $Internal

-- | Escape a string for inclusion in a TeX document
escapeTeX :: Text -> Text
escapeTeX :: Text -> Text
escapeTeX = (Text -> Char -> Text) -> Text -> Text -> Text
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl Text -> Char -> Text
go Text
""
  where
    go :: Text -> Char -> Text
    go :: Text -> Char -> Text
go Text
acc = \case
      Char
'#'  -> Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\#"
      Char
'$'  -> Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\$"
      Char
'%'  -> Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\%"
      Char
'&'  -> Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\&"
      Char
'\\' -> Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\textbackslash{}"
      Char
'^'  -> Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\textasciicircum{}"
      Char
'_'  -> Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\_"
      Char
'{'  -> Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\{"
      Char
'}'  -> Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\}"
      Char
'~'  -> Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\textasciitilde{}"
      Char
c    -> Text
acc Text -> Char -> Text
`T.snoc` Char
c

-- | Parse an array or string in simplified CSV format
--
-- Strings are split on commas, and leading/trailing whitespace is removed
-- from each item.
parseCSV :: A.FromJSON a => A.Value -> AT.Parser [a]
parseCSV :: Value -> Parser [a]
parseCSV = \case
    (A.String Text
t) -> (Text -> Parser a) -> [Text] -> Parser [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser a) -> (Text -> Value) -> Text -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
A.String (Text -> Value) -> (Text -> Text) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip) ([Text] -> Parser [a]) -> [Text] -> Parser [a]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
"," Text
t
    (A.Array Array
v)  -> (Value -> Parser a) -> [Value] -> Parser [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON ([Value] -> Parser [a]) -> [Value] -> Parser [a]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
v
    A.Object{}   -> String -> Parser [a]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected object"
    Value
value        -> (a -> [a] -> [a]
forall a. a -> [a] -> [a]
: []) (a -> [a]) -> Parser a -> Parser [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value

-- | Parse any scalar value as a string
--
-- Strings, numbers, booleans, and null are parsed as a string.  Empty
-- strings, arrays, and objects result in an error.
parseToString :: A.Value -> AT.Parser Text
parseToString :: Value -> Parser Text
parseToString = \case
    (A.String Text
t)
      | Text -> Bool
T.null Text
t  -> String -> Parser Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty string"
      | Bool
otherwise -> Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
    (A.Number Scientific
n)  -> Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser Text)
-> (Either Double Integer -> Text)
-> Either Double Integer
-> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text)
-> (Either Double Integer -> String)
-> Either Double Integer
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> String)
-> (Integer -> String) -> Either Double Integer -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Show Double => Double -> String
forall a. Show a => a -> String
show @Double) (Show Integer => Integer -> String
forall a. Show a => a -> String
show @Integer) (Either Double Integer -> Parser Text)
-> Either Double Integer -> Parser Text
forall a b. (a -> b) -> a -> b
$
      Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
Sci.floatingOrInteger Scientific
n
    (A.Bool Bool
b)    -> Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ if Bool
b then Text
"true" else Text
"false"
    Value
A.Null        -> Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"null"
    A.Array{}     -> String -> Parser Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected array"
    A.Object{}    -> String -> Parser Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected object"