{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# OPTIONS_GHC -Wno-type-defaults #-}

-- | Partial implementation of
-- | <https://alligator.io/css/css-grid-layout-grid-areas grid area CSS API>.
module Clay.Grid
(
    -- * Grid
    --
    -- $gridIntro
    gridGap
  , gridTemplateColumns

    -- * Size and location
    --
    -- $sizeAndLocationIntro

    -- ** Data types and type classes
  , GridLine
  , ToGridLine
  , GridLines2
  , ToGridLines2
  , GridLines4
  , ToGridLines4
  , OneGridLine
  , TwoGridLines
  , ThreeGridLines
  , FourGridLines
  , CustomIdentGrid
  , customIdentToText
  , partialMkCustomIdentGrid
  , ToSpan

    -- ** Style properties
    --
    -- $invalidValues
  , gridArea
  , gridColumn
  , gridColumnStart
  , gridColumnEnd
  , gridRow
  , gridRowStart
  , gridRowEnd

    -- ** Keywords
  , (//)
  , span_
)
where

import qualified Clay.Common as Com
import           Clay.Property (Val, Value, noCommas, value)
import           Clay.Size (Size)
import           Clay.Stylesheet (Css, key)
import           Data.Char (isNumber)
import           Data.Text (Text)
import qualified Data.Text as T
import           Prelude

-- $gridIntro
-- @grid-gap@ and @grid-template@ CSS properties.
--
-- === Example
-- For the below CSS code:
--
-- @
-- .grid1 {
--   display: grid;
--   width: max-content;
-- }
--
-- .grid3 {
--   display: grid;
--   width: max-content;
-- }
--
-- \@media (min-width: 40.0rem) {
--   .grid3 {
--     display: grid;
--     grid-template-columns: 1fr 1fr 1fr;
--     grid-gap: 1rem;
--     width: max-content;
--   }
-- }
-- @
--
-- The corresponding clay code is:
--
-- @
--  ".grid1" ? do
--    display grid
--    width maxContent
--  ".grid3" ? do
--    display grid
--    width maxContent
--  query M.screen [M.minWidth (rem 40)] $ ".grid3" ? do
--    display grid
--    gridTemplateColumns [fr 1, fr 1, fr 1]
--    gridGap $ rem 1
--    width maxContent
-- @

-- | Property sets the gaps (gutters) between rows and columns.
gridGap :: Size a -> Css
gridGap :: forall a. Size a -> Css
gridGap = Key (Size a) -> Size a -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size a)
"grid-gap"

-- | Property defines the line names and track sizing functions of the grid columns.
gridTemplateColumns :: [Size a] -> Css
gridTemplateColumns :: forall a. [Size a] -> Css
gridTemplateColumns = Key Value -> Value -> Css
forall a. Val a => Key a -> a -> Css
key Key Value
"grid-template-columns" (Value -> Css) -> ([Size a] -> Value) -> [Size a] -> Css
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Size a] -> Value
forall a. Val a => [a] -> Value
noCommas

-- $sizeAndLocationIntro
--
-- == CSS documentation
-- The below functions are based on
-- [MDN Web Docs](https://developer.mozilla.org/en-US/docs/Web/CSS)
-- CSS documentation.
--
-- === __Naming note__
-- In this documentation, as the functions are polymorphic we sometimes
-- refer to the CSS types as used in the
-- [mdm web docs_](https://developer.mozilla.org/en-US/docs/Web/CSS)
-- rather than the Haskell types.
-- For example, @grid-line@ is used instead of 'GridLine' as a the argument
-- might be provided as a 'GridLine' but also as an 'Integer', 'String', etc.
--
-- == Pragma
-- #pragma#
-- If you want to avoid specifying the types of the arguments, enable
-- the @ExtendedDefaultRules@ GHC language pragma as well as the
-- @-Wno-type-defaults@ GHC option to avoid compilation warnings.
--
-- @
-- {-# LANGUAGE ExtendedDefaultRules #-}
-- {-# OPTIONS_GHC -Wno-type-defaults #-}
-- @
--
-- === __Examples__
-- With the above enabled, you can write:
--
-- >> gridRowStart 2
--
-- >> gridRowStart "somegridarea"
--
-- If you do not enable those, then you must write:
--
-- >> gridRowStart (2 :: Integer)
--
-- >> gridRowStart ("somegridarea" :: String)
--
-- === __Note__
-- If you decide to enable the above, it is advisable to have your Clay
-- CSS code in its own module, so the behaviour of the rest of your code
-- is not affected.
--
-- == Examples
-- Examples are provided through the documentation for the various functions.
-- Further examples can be found in the source code of the test suite
-- in the GridSpec.hs module.

-- | A @grid-line@ value.
--
-- A @grid-line@ value specifies a size and location in a grid.
--
-- === __Note__
-- To know more about @grid-line@ value, see for example the documentation of
-- the [grid-row-start](https://developer.mozilla.org/en-US/docs/Web/CSS/grid-row-start)
-- CSS property.
data GridLine

  -- | 'Integer' value.
  --
  -- __NOTE:__ 'Integer' value of 0 is invalid.
  = Coordinate Integer

  -- | @custom-ident@ with an optional 'Integer' value.
  --
  -- __NOTE:__ 'Integer' value of 0 is invalid.
  | GridLineCustomIdent CustomIdentGrid (Maybe Integer)

  -- | @span@ CSS keyword with an optional @custom-ident@
  -- | and/or 'Integer' value.
  --
  -- __NOTE:__ negative 'Integer' or 0 are invalid.
  | Span (Maybe CustomIdentGrid) (Maybe Integer)

  -- | Other grid line values: @auto@, @inherit@, @initial@, @unset@.
  | OtherGridLine Value
  deriving (GridLine -> GridLine -> Bool
(GridLine -> GridLine -> Bool)
-> (GridLine -> GridLine -> Bool) -> Eq GridLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GridLine -> GridLine -> Bool
== :: GridLine -> GridLine -> Bool
$c/= :: GridLine -> GridLine -> Bool
/= :: GridLine -> GridLine -> Bool
Eq, Int -> GridLine -> ShowS
[GridLine] -> ShowS
GridLine -> String
(Int -> GridLine -> ShowS)
-> (GridLine -> String) -> ([GridLine] -> ShowS) -> Show GridLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GridLine -> ShowS
showsPrec :: Int -> GridLine -> ShowS
$cshow :: GridLine -> String
show :: GridLine -> String
$cshowList :: [GridLine] -> ShowS
showList :: [GridLine] -> ShowS
Show)

class ToGridLine a where
  -- | Convert the provided type to a 'GridLine'.
  toGridLine :: a -> GridLine

instance ToGridLine GridLine where
  toGridLine :: GridLine -> GridLine
toGridLine = GridLine -> GridLine
forall a. a -> a
id

instance ToGridLine Integer where
  -- | __NOTE:__ 'Integer' value of 0 is invalid.
  toGridLine :: Integer -> GridLine
toGridLine = Integer -> GridLine
Coordinate

-- | @custom-ident@ value.
instance ToGridLine CustomIdentGrid where
  toGridLine :: CustomIdentGrid -> GridLine
toGridLine CustomIdentGrid
x = CustomIdentGrid -> Maybe Integer -> GridLine
GridLineCustomIdent CustomIdentGrid
x Maybe Integer
forall a. Maybe a
Nothing

-- | @custom-ident@ value.
instance ToGridLine String where
  toGridLine :: String -> GridLine
toGridLine = CustomIdentGrid -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine (CustomIdentGrid -> GridLine)
-> (String -> CustomIdentGrid) -> String -> GridLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CustomIdentGrid
partialMkCustomIdentGrid (Text -> CustomIdentGrid)
-> (String -> Text) -> String -> CustomIdentGrid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Both @custom-ident@ and `Integer` values, provided as a pair.
--
-- __NOTE:__ 'Integer' value of 0 is invalid.
instance ToGridLine (CustomIdentGrid, Integer) where
  toGridLine :: (CustomIdentGrid, Integer) -> GridLine
toGridLine (CustomIdentGrid
x, Integer
y) = CustomIdentGrid -> Maybe Integer -> GridLine
GridLineCustomIdent CustomIdentGrid
x (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
y)

-- | Both @custom-ident@ and `Integer` values, provided as a pair.
--
-- __NOTE:__ 'Integer' value of 0 is invalid.
instance ToGridLine (String, Integer) where
  toGridLine :: (String, Integer) -> GridLine
toGridLine (String
x, Integer
y) = (CustomIdentGrid, Integer) -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine (Text -> CustomIdentGrid
partialMkCustomIdentGrid (Text -> CustomIdentGrid) -> Text -> CustomIdentGrid
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x, Integer
y)

-- | One or two @grid-line@ values.
data GridLines2
    -- | One @grid-line@ value.
  = One2 OneGridLine
    -- | Two @grid-line@ values.
  | Two2 TwoGridLines

class ToGridLines2 a where

  -- | Convert the provided type to 'GridLines2' (one or two @grid-line@ values).
  toGridLines2 :: a -> GridLines2

-- | One @grid-line@ value.
instance ToGridLines2 GridLine where
  toGridLines2 :: GridLine -> GridLines2
toGridLines2 = OneGridLine -> GridLines2
One2 (OneGridLine -> GridLines2)
-> (GridLine -> OneGridLine) -> GridLine -> GridLines2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GridLine -> OneGridLine
OneGridLine

-- | One @grid-line@ value.
instance ToGridLines2 OneGridLine where
  toGridLines2 :: OneGridLine -> GridLines2
toGridLines2 = OneGridLine -> GridLines2
One2

-- | Two @grid-line@ values.
instance ToGridLines2 TwoGridLines where
  toGridLines2 :: TwoGridLines -> GridLines2
toGridLines2 = TwoGridLines -> GridLines2
Two2

-- | One or two @grid-line@ values.
instance ToGridLines2 GridLines2 where
  toGridLines2 :: GridLines2 -> GridLines2
toGridLines2 = GridLines2 -> GridLines2
forall a. a -> a
id

-- | One 'Integer' value.
--
-- __NOTE:__ 'Integer' value of 0 is invalid.
instance ToGridLines2 Integer where
  toGridLines2 :: Integer -> GridLines2
toGridLines2 = GridLine -> GridLines2
forall a. ToGridLines2 a => a -> GridLines2
toGridLines2 (GridLine -> GridLines2)
-> (Integer -> GridLine) -> Integer -> GridLines2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine

-- | One @custom-ident@ value.
instance ToGridLines2 CustomIdentGrid where
  toGridLines2 :: CustomIdentGrid -> GridLines2
toGridLines2 = GridLine -> GridLines2
forall a. ToGridLines2 a => a -> GridLines2
toGridLines2 (GridLine -> GridLines2)
-> (CustomIdentGrid -> GridLine) -> CustomIdentGrid -> GridLines2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CustomIdentGrid -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine

-- | One @custom-ident@ value.
instance ToGridLines2 String where
  toGridLines2 :: String -> GridLines2
toGridLines2 = GridLine -> GridLines2
forall a. ToGridLines2 a => a -> GridLines2
toGridLines2 (GridLine -> GridLines2)
-> (String -> GridLine) -> String -> GridLines2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine

-- | One time both a @custom-ident@ and 'Integer' values, provided as a pair.
--
-- __NOTE:__ 'Integer' value of 0 is invalid.
instance ToGridLines2 (CustomIdentGrid, Integer) where
  toGridLines2 :: (CustomIdentGrid, Integer) -> GridLines2
toGridLines2 = GridLine -> GridLines2
forall a. ToGridLines2 a => a -> GridLines2
toGridLines2 (GridLine -> GridLines2)
-> ((CustomIdentGrid, Integer) -> GridLine)
-> (CustomIdentGrid, Integer)
-> GridLines2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CustomIdentGrid, Integer) -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine

-- | One time both a @custom-ident@ and 'Integer' values, provided as a pair.
--
-- __NOTE:__ 'Integer' value of 0 is invalid.
instance ToGridLines2 (String, Integer) where
  toGridLines2 :: (String, Integer) -> GridLines2
toGridLines2 = GridLine -> GridLines2
forall a. ToGridLines2 a => a -> GridLines2
toGridLines2 (GridLine -> GridLines2)
-> ((String, Integer) -> GridLine)
-> (String, Integer)
-> GridLines2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Integer) -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine

-- | One, two, three or four @grid-line@ values.
data GridLines4

    -- | One @grid-line@ value.
  = One4 OneGridLine

    -- | Two @grid-line@ values.
  | Two4 TwoGridLines

    -- | Three @grid-line@ values.
  | Three4 ThreeGridLines

    -- | Four @grid-line@ values.
  | Four4 FourGridLines

class ToGridLines4 a where
  -- | Convert the provided type to 'GridLines4'
  -- (one, two, three or four @grid-line@ values).
  toGridLines4 :: a -> GridLines4

-- | One @grid-line@ value.
instance ToGridLines4 GridLine where
  toGridLines4 :: GridLine -> GridLines4
toGridLines4 = OneGridLine -> GridLines4
One4 (OneGridLine -> GridLines4)
-> (GridLine -> OneGridLine) -> GridLine -> GridLines4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GridLine -> OneGridLine
OneGridLine

-- | One @grid-line@ value.
instance ToGridLines4 OneGridLine where
  toGridLines4 :: OneGridLine -> GridLines4
toGridLines4 = OneGridLine -> GridLines4
One4

-- | Two @grid-line@ values.
instance ToGridLines4 TwoGridLines where
  toGridLines4 :: TwoGridLines -> GridLines4
toGridLines4 = TwoGridLines -> GridLines4
Two4

-- | Three @grid-line@ values.
instance ToGridLines4 ThreeGridLines where
  toGridLines4 :: ThreeGridLines -> GridLines4
toGridLines4 = ThreeGridLines -> GridLines4
Three4

-- | Four @grid-line@ values.
instance ToGridLines4 FourGridLines where
  toGridLines4 :: FourGridLines -> GridLines4
toGridLines4 = FourGridLines -> GridLines4
Four4

-- | One, two, three or four @grid-line@ values.
instance ToGridLines4 GridLines4 where
  toGridLines4 :: GridLines4 -> GridLines4
toGridLines4 = GridLines4 -> GridLines4
forall a. a -> a
id

-- | One 'Integer' value.
--
-- __NOTE:__ 'Integer' value of 0 is invalid.
instance ToGridLines4 Integer where
  toGridLines4 :: Integer -> GridLines4
toGridLines4 = GridLine -> GridLines4
forall a. ToGridLines4 a => a -> GridLines4
toGridLines4 (GridLine -> GridLines4)
-> (Integer -> GridLine) -> Integer -> GridLines4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine

-- | One @custom-ident@ value.
instance ToGridLines4 CustomIdentGrid where
  toGridLines4 :: CustomIdentGrid -> GridLines4
toGridLines4 = GridLine -> GridLines4
forall a. ToGridLines4 a => a -> GridLines4
toGridLines4 (GridLine -> GridLines4)
-> (CustomIdentGrid -> GridLine) -> CustomIdentGrid -> GridLines4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CustomIdentGrid -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine

-- | One @custom-ident@ value.
instance ToGridLines4 String where
  toGridLines4 :: String -> GridLines4
toGridLines4 = GridLine -> GridLines4
forall a. ToGridLines4 a => a -> GridLines4
toGridLines4 (GridLine -> GridLines4)
-> (String -> GridLine) -> String -> GridLines4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine

-- | One time both a @custom-ident@ and 'Integer' values, provided as a pair.
--
-- __NOTE:__ 'Integer' value of 0 is invalid.
instance ToGridLines4 (CustomIdentGrid, Integer) where
  toGridLines4 :: (CustomIdentGrid, Integer) -> GridLines4
toGridLines4 = GridLine -> GridLines4
forall a. ToGridLines4 a => a -> GridLines4
toGridLines4 (GridLine -> GridLines4)
-> ((CustomIdentGrid, Integer) -> GridLine)
-> (CustomIdentGrid, Integer)
-> GridLines4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CustomIdentGrid, Integer) -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine

-- | One time both a @custom-ident@ and 'Integer' values, provided as a pair.
--
-- __NOTE:__ 'Integer' value of 0 is invalid.
instance ToGridLines4 (String, Integer) where
  toGridLines4 :: (String, Integer) -> GridLines4
toGridLines4 = GridLine -> GridLines4
forall a. ToGridLines4 a => a -> GridLines4
toGridLines4 (GridLine -> GridLines4)
-> ((String, Integer) -> GridLine)
-> (String, Integer)
-> GridLines4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Integer) -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine

-- | One 'GridLine' value.
newtype OneGridLine = OneGridLine GridLine

-- | Two 'GridLine' values.
data TwoGridLines = TwoGridLines GridLine GridLine

-- | Three 'GridLine' values.
data ThreeGridLines = ThreeGridLines GridLine GridLine GridLine

-- | Four 'GridLine' values.
data FourGridLines = FourGridLines GridLine GridLine GridLine GridLine

-- | CSS @custom-ident@.
--
-- The data constructor is not exported. Use the 'partialMkCustomIdentGrid'
-- smart constructor to create a 'CustomIdentGrid'.
--
-- === __Note__
-- In CSS, some values for @custom-ident@ are invalid depending on the CSS
-- property the @custom-ident@ is used with.
-- Consequently, the @custom-ident@ is only for CSS grid.
newtype CustomIdentGrid = CustomIdentGrid Text deriving (CustomIdentGrid -> CustomIdentGrid -> Bool
(CustomIdentGrid -> CustomIdentGrid -> Bool)
-> (CustomIdentGrid -> CustomIdentGrid -> Bool)
-> Eq CustomIdentGrid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CustomIdentGrid -> CustomIdentGrid -> Bool
== :: CustomIdentGrid -> CustomIdentGrid -> Bool
$c/= :: CustomIdentGrid -> CustomIdentGrid -> Bool
/= :: CustomIdentGrid -> CustomIdentGrid -> Bool
Eq, Eq CustomIdentGrid
Eq CustomIdentGrid =>
(CustomIdentGrid -> CustomIdentGrid -> Ordering)
-> (CustomIdentGrid -> CustomIdentGrid -> Bool)
-> (CustomIdentGrid -> CustomIdentGrid -> Bool)
-> (CustomIdentGrid -> CustomIdentGrid -> Bool)
-> (CustomIdentGrid -> CustomIdentGrid -> Bool)
-> (CustomIdentGrid -> CustomIdentGrid -> CustomIdentGrid)
-> (CustomIdentGrid -> CustomIdentGrid -> CustomIdentGrid)
-> Ord CustomIdentGrid
CustomIdentGrid -> CustomIdentGrid -> Bool
CustomIdentGrid -> CustomIdentGrid -> Ordering
CustomIdentGrid -> CustomIdentGrid -> CustomIdentGrid
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 :: CustomIdentGrid -> CustomIdentGrid -> Ordering
compare :: CustomIdentGrid -> CustomIdentGrid -> Ordering
$c< :: CustomIdentGrid -> CustomIdentGrid -> Bool
< :: CustomIdentGrid -> CustomIdentGrid -> Bool
$c<= :: CustomIdentGrid -> CustomIdentGrid -> Bool
<= :: CustomIdentGrid -> CustomIdentGrid -> Bool
$c> :: CustomIdentGrid -> CustomIdentGrid -> Bool
> :: CustomIdentGrid -> CustomIdentGrid -> Bool
$c>= :: CustomIdentGrid -> CustomIdentGrid -> Bool
>= :: CustomIdentGrid -> CustomIdentGrid -> Bool
$cmax :: CustomIdentGrid -> CustomIdentGrid -> CustomIdentGrid
max :: CustomIdentGrid -> CustomIdentGrid -> CustomIdentGrid
$cmin :: CustomIdentGrid -> CustomIdentGrid -> CustomIdentGrid
min :: CustomIdentGrid -> CustomIdentGrid -> CustomIdentGrid
Ord, ReadPrec [CustomIdentGrid]
ReadPrec CustomIdentGrid
Int -> ReadS CustomIdentGrid
ReadS [CustomIdentGrid]
(Int -> ReadS CustomIdentGrid)
-> ReadS [CustomIdentGrid]
-> ReadPrec CustomIdentGrid
-> ReadPrec [CustomIdentGrid]
-> Read CustomIdentGrid
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CustomIdentGrid
readsPrec :: Int -> ReadS CustomIdentGrid
$creadList :: ReadS [CustomIdentGrid]
readList :: ReadS [CustomIdentGrid]
$creadPrec :: ReadPrec CustomIdentGrid
readPrec :: ReadPrec CustomIdentGrid
$creadListPrec :: ReadPrec [CustomIdentGrid]
readListPrec :: ReadPrec [CustomIdentGrid]
Read, Int -> CustomIdentGrid -> ShowS
[CustomIdentGrid] -> ShowS
CustomIdentGrid -> String
(Int -> CustomIdentGrid -> ShowS)
-> (CustomIdentGrid -> String)
-> ([CustomIdentGrid] -> ShowS)
-> Show CustomIdentGrid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CustomIdentGrid -> ShowS
showsPrec :: Int -> CustomIdentGrid -> ShowS
$cshow :: CustomIdentGrid -> String
show :: CustomIdentGrid -> String
$cshowList :: [CustomIdentGrid] -> ShowS
showList :: [CustomIdentGrid] -> ShowS
Show)

-- | Convert a 'CustomIdentGrid' to 'Text'.
--
-- === __Note__
-- The function is defined on its own as the newtype constructor
-- of 'CustomIdentGrid'is not exported.
customIdentToText :: CustomIdentGrid -> Text
customIdentToText :: CustomIdentGrid -> Text
customIdentToText (CustomIdentGrid Text
x) = Text
x

-- | Create a 'CustomIdentGrid'.
--
-- __WARNING__: this function is partial. An error will be raised if:
--
-- * "span" is provided as a value (this is a reserved keyword in this context)
-- * a number is provided as first character
-- * __If__ a hyphen (-) is provided as first character:
--
--     ** a number is provided as second character
--     ** a hyphen (-) is provided as second character.
--
-- === __Note__
-- The above is a partial implementation of the CSS custom-ident naming rules.
-- If you stick to the following charset @[a-zA-z0-9-_]@ the checks will be effective
-- and your CSS custom-ident will be a valid one.
-- On the other hand, the following will not be checked:
--
-- * character escaping (for example @\?@) or unicode
-- * characters provided as hexadecimal number (for example @\0x03BB@)
-- * characters outside of the above charset.
--
-- More information regarding this topic can be found on
-- [mdm web docs_](https://developer.mozilla.org/en-US/docs/Web/CSS/custom-ident)
partialMkCustomIdentGrid :: Text -> CustomIdentGrid
partialMkCustomIdentGrid :: Text -> CustomIdentGrid
partialMkCustomIdentGrid Text
"span" = String -> CustomIdentGrid
forall a. HasCallStack => String -> a
error String
"Custom-ident for a grid property cannot be named span"
partialMkCustomIdentGrid Text
txt = CustomIdentGrid
checkText
  where
    checkText :: CustomIdentGrid
checkText = Char -> CustomIdentGrid
checkHead ((Char, Text) -> Char
forall a b. (a, b) -> a
fst (Char, Text)
unconsTxt)

    checkHead :: Char -> CustomIdentGrid
    checkHead :: Char -> CustomIdentGrid
checkHead Char
c
      | Char -> Bool
isNumber Char
c = String -> CustomIdentGrid
forall a. HasCallStack => String -> a
error String
"Custom-ident cannot start with a number"
      | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'   = Maybe Char -> CustomIdentGrid
checkSecond Maybe Char
second
      | Bool
otherwise  = Text -> CustomIdentGrid
CustomIdentGrid Text
txt

    checkSecond :: Maybe Char -> CustomIdentGrid
checkSecond (Just Char
s)
      | Char
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' =
          String -> CustomIdentGrid
forall a. HasCallStack => String -> a
error String
"Custom-ident cannot start with two hyphens"
      | Char -> Bool
isNumber Char
s =
          String -> CustomIdentGrid
forall a. HasCallStack => String -> a
error String
"Custom-ident cannot start with a hyphen followed by a number"
      | Bool
otherwise = Text -> CustomIdentGrid
CustomIdentGrid Text
txt
    checkSecond Maybe Char
Nothing = Text -> CustomIdentGrid
CustomIdentGrid Text
txt

    unconsTxt :: (Char, Text)
unconsTxt = case Text -> Maybe (Char, Text)
T.uncons Text
txt of
      Maybe (Char, Text)
Nothing -> String -> (Char, Text)
forall a. HasCallStack => String -> a
error String
"Custom-ident cannot be empty"
      Just (Char
f, Text
r) -> (Char
f, Text
r)

    second :: Maybe Char
    second :: Maybe Char
second = (Char, Text) -> Char
forall a b. (a, b) -> a
fst ((Char, Text) -> Char) -> Maybe (Char, Text) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Char, Text)
T.uncons ((Char, Text) -> Text
forall a b. (a, b) -> b
snd (Char, Text)
unconsTxt)

-- $invalidValues
--
-- #partial#
-- The below functions are partial. They will raise an error if
-- provided with a @grid-line@ value which is:
--
-- * an 'Integer' value of 0
-- * a pair with an 'Integer' component of value 0
-- * a 'span_' function provided with an 'Integer' value of 0 or negative
-- * a 'span_' function provided with a pair value with
-- an 'Integer' component of 0 or negative.
-- * an invalid @custom-ident@ value, see 'partialMkCustomIdentGrid'.

-- | Property shorthand specifies a grid item's size and location
-- within a grid.
--
-- One to four @grid-line@ values can be specified.
-- Grid-line values must be separated by a '(//)' operator.
--
-- __WARNING:__ this function is partial. See above "Clay.Grid#partial".
--
-- ==== __Examples__
--
-- The below examples assume that the @ExtendedDefaultRules@ GHC language
-- pragma is enabled. See above "Clay.Grid#pragma".
--
-- > gridArea (auto :: GridLine)
--
-- > gridArea "somegridarea"
--
-- > gridArea $ ("somegridarea", 4) // ("someothergridarea", 2)
--
-- > gridArea $ 1 // 3 // 4
gridArea :: ToGridLines4 a => a -> Css
gridArea :: forall a. ToGridLines4 a => a -> Css
gridArea a
x = Key GridLines4 -> GridLines4 -> Css
forall a. Val a => Key a -> a -> Css
key Key GridLines4
"grid-area" (a -> GridLines4
forall a. ToGridLines4 a => a -> GridLines4
partialToGridLines4 a
x)

-- | Property shorthand specifies a grid item's size and location
-- within a grid column.
--
-- __WARNING:__ this function is partial. See above "Clay.Grid#partial".
--
-- ==== __Examples__
--
-- The below examples assume that the @ExtendedDefaultRules@ GHC language
-- pragma is enabled. See above "Clay.Grid#pragma".
--
-- > gridColumn (auto :: GridLine)
--
-- > gridColumn $ span_ 3
--
-- > gridColumn $ span_ ("somegridarea", 5)
--
-- > gridColumn $ span_ 3 // 6
gridColumn :: ToGridLines2 a => a -> Css
gridColumn :: forall a. ToGridLines2 a => a -> Css
gridColumn a
x = Key GridLines2 -> GridLines2 -> Css
forall a. Val a => Key a -> a -> Css
key Key GridLines2
"grid-column" (a -> GridLines2
forall a. ToGridLines2 a => a -> GridLines2
partialToGridLines2 a
x)

-- | Property specifies a grid item's start position within the grid column.
--
-- __WARNING:__ this function is partial. See above "Clay.Grid#partial".
--
-- ==== __Examples__
--
-- The below examples assume that the @ExtendedDefaultRules@ GHC language
-- pragma is enabled. See above "Clay.Grid#pragma".
--
-- > gridColumnStart (inherit :: GridLine)
--
-- > gridColumnStart 2
--
-- > gridColumnStart ("somegridarea", 4)
--
-- > gridColumnStart $ span_ ("somegridarea", 5)
gridColumnStart :: ToGridLine a => a -> Css
gridColumnStart :: forall a. ToGridLine a => a -> Css
gridColumnStart a
x = Key GridLine -> GridLine -> Css
forall a. Val a => Key a -> a -> Css
key Key GridLine
"grid-column-start" (a -> GridLine
forall a. ToGridLine a => a -> GridLine
partialToGridLine a
x)

-- | Property specifies a grid item's end position within the grid column.
--
-- __WARNING:__ this function is partial. See above "Clay.Grid#partial".
--
-- ==== __Examples__
--
-- The below examples assume that the @ExtendedDefaultRules@ GHC language
-- pragma is enabled. See above "Clay.Grid#pragma".
--
-- > gridColumnEnd (initial :: GridLine)
--
-- > gridColumnEnd 2
--
-- > gridColumnEnd "somegridarea"
--
-- > gridColumnEnd $ span_ "somegridarea"
gridColumnEnd :: ToGridLine a => a -> Css
gridColumnEnd :: forall a. ToGridLine a => a -> Css
gridColumnEnd a
x = Key GridLine -> GridLine -> Css
forall a. Val a => Key a -> a -> Css
key Key GridLine
"grid-column-end" (a -> GridLine
forall a. ToGridLine a => a -> GridLine
partialToGridLine a
x)

-- | Property shorthand specifies a grid item's size and location
-- within a grid row.
--
-- One or two @grid-line@ values can be specified.
-- @grid-line@ values must be separated by a '(//)' operator.
--
-- __WARNING:__ this function is partial. See above "Clay.Grid#partial".
--
-- ==== __Examples__
--
-- The below examples assume that the @ExtendedDefaultRules@ GHC language
-- pragma is enabled. See above "Clay.Grid#pragma".
--
-- > gridRow (unset :: GridLine)
--
-- > gridRow $ span_ 3
--
-- > gridRow $ span_ 3 // 6
--
-- > gridRow $ span_ ("somegridarea", 5) // span_ 2
gridRow :: ToGridLines2 a => a -> Css
gridRow :: forall a. ToGridLines2 a => a -> Css
gridRow a
x = Key GridLines2 -> GridLines2 -> Css
forall a. Val a => Key a -> a -> Css
key Key GridLines2
"grid-row" (a -> GridLines2
forall a. ToGridLines2 a => a -> GridLines2
partialToGridLines2 a
x)

-- | Property specifies a grid item's start position within the grid row.
--
-- __WARNING:__ this function is partial. See above "Clay.Grid#partial".
--
-- ==== __Examples__
--
-- The below examples assume that the @ExtendedDefaultRules@ GHC language
-- pragma is enabled. See above "Clay.Grid#pragma".
--
-- > gridRowStart (initial :: GridLine)
--
-- > gridRowStart (-2)
--
-- > gridRowStart $ span_ "somegridarea"
--
-- > gridRowStart "somegridarea"
gridRowStart :: ToGridLine a => a -> Css
gridRowStart :: forall a. ToGridLine a => a -> Css
gridRowStart a
x = Key GridLine -> GridLine -> Css
forall a. Val a => Key a -> a -> Css
key Key GridLine
"grid-row-start" (a -> GridLine
forall a. ToGridLine a => a -> GridLine
partialToGridLine a
x)

-- | Property specifies a grid item's end position within the grid row.
--
-- __WARNING:__ this function is partial. See above "Clay.Grid#partial".
--
-- ==== __Examples__
--
-- The below examples assume that the @ExtendedDefaultRules@ GHC language
-- pragma is enabled. See above "Clay.Grid#pragma".
--
-- > gridRowEnd (auto :: GridLine)
--
-- > gridRowEnd (-2)
--
-- > gridRowEnd ("somegridarea", 4)
--
-- > gridRowEnd $ span_ 3
gridRowEnd :: ToGridLine a => a -> Css
gridRowEnd :: forall a. ToGridLine a => a -> Css
gridRowEnd a
x = Key GridLine -> GridLine -> Css
forall a. Val a => Key a -> a -> Css
key Key GridLine
"grid-row-end" (a -> GridLine
forall a. ToGridLine a => a -> GridLine
partialToGridLine a
x)

class Slash a r | a -> r where
  -- | `/` CSS operator.
  -- Separates @grid-line@ values.
  (//) :: ToGridLine b => a -> b -> r

instance Slash GridLine TwoGridLines where
  GridLine
x // :: forall b. ToGridLine b => GridLine -> b -> TwoGridLines
// b
y = GridLine -> GridLine -> TwoGridLines
TwoGridLines GridLine
x (b -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine b
y)

instance Slash Integer TwoGridLines where
  Integer
x // :: forall b. ToGridLine b => Integer -> b -> TwoGridLines
// b
y = GridLine -> GridLine -> TwoGridLines
TwoGridLines (Integer -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine Integer
x) (b -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine b
y)

instance Slash CustomIdentGrid TwoGridLines where
  CustomIdentGrid
x // :: forall b. ToGridLine b => CustomIdentGrid -> b -> TwoGridLines
// b
y = GridLine -> GridLine -> TwoGridLines
TwoGridLines (CustomIdentGrid -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine CustomIdentGrid
x) (b -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine b
y)

instance Slash String TwoGridLines where
  String
x // :: forall b. ToGridLine b => String -> b -> TwoGridLines
// b
y = GridLine -> GridLine -> TwoGridLines
TwoGridLines (String -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine String
x) (b -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine b
y)

instance Slash (CustomIdentGrid, Integer) TwoGridLines where
  (CustomIdentGrid, Integer)
x // :: forall b.
ToGridLine b =>
(CustomIdentGrid, Integer) -> b -> TwoGridLines
// b
y = GridLine -> GridLine -> TwoGridLines
TwoGridLines ((CustomIdentGrid, Integer) -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine (CustomIdentGrid, Integer)
x) (b -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine b
y)

instance Slash (String, Integer) TwoGridLines where
  (String, Integer)
x // :: forall b. ToGridLine b => (String, Integer) -> b -> TwoGridLines
// b
y = GridLine -> GridLine -> TwoGridLines
TwoGridLines ((String, Integer) -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine (String, Integer)
x) (b -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine b
y)

instance Slash TwoGridLines ThreeGridLines where
  (TwoGridLines GridLine
xx GridLine
xy) // :: forall b. ToGridLine b => TwoGridLines -> b -> ThreeGridLines
// b
y = GridLine -> GridLine -> GridLine -> ThreeGridLines
ThreeGridLines GridLine
xx GridLine
xy (b -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine b
y)

instance Slash ThreeGridLines FourGridLines where
  (ThreeGridLines GridLine
xx GridLine
xy GridLine
xz) // :: forall b. ToGridLine b => ThreeGridLines -> b -> FourGridLines
// b
y = GridLine -> GridLine -> GridLine -> GridLine -> FourGridLines
FourGridLines GridLine
xx GridLine
xy GridLine
xz (b -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine b
y)

class ToSpan a where

  -- | @span@ CSS keyword, contributes to the grid item's placement.
  span_ :: a -> GridLine

-- | Contributes the nth grid line to the grid item's placement.
--
-- __NOTE:__ negative 'Integer' or 0 values are invalid.
instance ToSpan Integer where
  span_ :: Integer -> GridLine
span_ Integer
x = Maybe CustomIdentGrid -> Maybe Integer -> GridLine
Span Maybe CustomIdentGrid
forall a. Maybe a
Nothing (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
x)

-- | One line from the provided name is counted.
instance ToSpan String where
  span_ :: String -> GridLine
span_ String
x = Maybe CustomIdentGrid -> Maybe Integer -> GridLine
Span (CustomIdentGrid -> Maybe CustomIdentGrid
forall a. a -> Maybe a
Just (CustomIdentGrid -> Maybe CustomIdentGrid)
-> (Text -> CustomIdentGrid) -> Text -> Maybe CustomIdentGrid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CustomIdentGrid
partialMkCustomIdentGrid (Text -> Maybe CustomIdentGrid) -> Text -> Maybe CustomIdentGrid
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x) Maybe Integer
forall a. Maybe a
Nothing

-- | Nth lines from the provided name are counted.
--
-- __NOTE:__ negative 'Integer' or 0 values are invalid.
instance ToSpan (String, Integer) where
  span_ :: (String, Integer) -> GridLine
span_ (String
x, Integer
y) = Maybe CustomIdentGrid -> Maybe Integer -> GridLine
Span (CustomIdentGrid -> Maybe CustomIdentGrid
forall a. a -> Maybe a
Just (CustomIdentGrid -> Maybe CustomIdentGrid)
-> (Text -> CustomIdentGrid) -> Text -> Maybe CustomIdentGrid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CustomIdentGrid
partialMkCustomIdentGrid (Text -> Maybe CustomIdentGrid) -> Text -> Maybe CustomIdentGrid
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x) (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
y)

-- | Keyword indicating that the property contributes nothing
-- to the grid item's placement.
instance Com.Auto GridLine where
  auto :: GridLine
auto = Value -> GridLine
OtherGridLine (Value -> GridLine) -> Value -> GridLine
forall a b. (a -> b) -> a -> b
$ Text -> Value
forall a. Val a => a -> Value
value (Text
"auto" :: Text)

-- | Keyword `inherit` applied to a 'GridLine'.
instance Com.Inherit GridLine where
  inherit :: GridLine
inherit = Value -> GridLine
OtherGridLine (Value -> GridLine) -> Value -> GridLine
forall a b. (a -> b) -> a -> b
$ Text -> Value
forall a. Val a => a -> Value
value (Text
"inherit" :: Text)

-- | Keyword `initial` applied to a 'GridLine'.
instance Com.Initial GridLine where
  initial :: GridLine
initial = Value -> GridLine
OtherGridLine (Value -> GridLine) -> Value -> GridLine
forall a b. (a -> b) -> a -> b
$ Text -> Value
forall a. Val a => a -> Value
value (Text
"initial" :: Text)

-- | Keyword `unset` applied to a 'GridLine'.
instance Com.Unset GridLine where
  unset :: GridLine
unset = Value -> GridLine
OtherGridLine (Value -> GridLine) -> Value -> GridLine
forall a b. (a -> b) -> a -> b
$ Text -> Value
forall a. Val a => a -> Value
value (Text
"unset" :: Text)

-- | Convertion of 'GridLine' to 'Clay.Property.Value'.
instance Val GridLine where
  value :: GridLine -> Value
value (OtherGridLine Value
val)       = Value
val
  value (Coordinate Integer
x)            = Integer -> Value
forall a. Val a => a -> Value
value Integer
x
  value (GridLineCustomIdent CustomIdentGrid
x Maybe Integer
y) =
    Text -> Value
forall a. Val a => a -> Value
value (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ CustomIdentGrid -> Text
customIdentToText CustomIdentGrid
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Integer -> Text) -> Maybe Integer -> Text
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Integer -> Text) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Text
forall a. Show a => a -> Text
tshow) Maybe Integer
y
  value (Span Maybe CustomIdentGrid
x Maybe Integer
y) =
    Text -> Value
forall a. Val a => a -> Value
value (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Text
"span" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (CustomIdentGrid -> Text) -> Maybe CustomIdentGrid -> Text
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
    (Text -> Text)
-> (CustomIdentGrid -> Text) -> CustomIdentGrid -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CustomIdentGrid -> Text
customIdentToText) Maybe CustomIdentGrid
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Integer -> Text) -> Maybe Integer -> Text
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Integer -> Text) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Text
forall a. Show a => a -> Text
tshow) Maybe Integer
y

instance Val OneGridLine where
  value :: OneGridLine -> Value
value (OneGridLine GridLine
x) = GridLine -> Value
forall a. Val a => a -> Value
value GridLine
x

instance Val TwoGridLines where
  value :: TwoGridLines -> Value
value (TwoGridLines GridLine
x GridLine
y) =
    GridLine -> Value
forall a. Val a => a -> Value
value GridLine
x Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Text -> Value
forall a. Val a => a -> Value
value (Text
" / " :: Text) Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> GridLine -> Value
forall a. Val a => a -> Value
value GridLine
y

instance Val ThreeGridLines where
  value :: ThreeGridLines -> Value
value (ThreeGridLines GridLine
x GridLine
y GridLine
z) =
       GridLine -> Value
forall a. Val a => a -> Value
value GridLine
x
    Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Text -> Value
forall a. Val a => a -> Value
value (Text
" / " :: Text) Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> GridLine -> Value
forall a. Val a => a -> Value
value GridLine
y
    Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Text -> Value
forall a. Val a => a -> Value
value (Text
" / " :: Text) Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> GridLine -> Value
forall a. Val a => a -> Value
value GridLine
z

instance Val FourGridLines where
  value :: FourGridLines -> Value
value (FourGridLines GridLine
xx GridLine
xy GridLine
xz GridLine
yx) =
       GridLine -> Value
forall a. Val a => a -> Value
value GridLine
xx
    Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Text -> Value
forall a. Val a => a -> Value
value (Text
" / " :: Text) Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> GridLine -> Value
forall a. Val a => a -> Value
value GridLine
xy
    Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Text -> Value
forall a. Val a => a -> Value
value (Text
" / " :: Text) Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> GridLine -> Value
forall a. Val a => a -> Value
value GridLine
xz
    Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Text -> Value
forall a. Val a => a -> Value
value (Text
" / " :: Text) Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> GridLine -> Value
forall a. Val a => a -> Value
value GridLine
yx

instance Val GridLines2 where
  value :: GridLines2 -> Value
value (One2 OneGridLine
x) = OneGridLine -> Value
forall a. Val a => a -> Value
value OneGridLine
x
  value (Two2 TwoGridLines
x) = TwoGridLines -> Value
forall a. Val a => a -> Value
value TwoGridLines
x

instance Val GridLines4 where
  value :: GridLines4 -> Value
value (One4 OneGridLine
x)   = OneGridLine -> Value
forall a. Val a => a -> Value
value OneGridLine
x
  value (Two4 TwoGridLines
x)   = TwoGridLines -> Value
forall a. Val a => a -> Value
value TwoGridLines
x
  value (Three4 ThreeGridLines
x) = ThreeGridLines -> Value
forall a. Val a => a -> Value
value ThreeGridLines
x
  value (Four4 FourGridLines
x)  = FourGridLines -> Value
forall a. Val a => a -> Value
value FourGridLines
x

-- | Private partial function checking a 'GridLine'.
--
-- An error is raised when:
-- - An 'Integer' value of 0 is provided.
-- - A negative 'Integer' value is provided for a 'Span' constructor.
--
-- Otherwise, the initially provided 'GridLine' value is returned.
partialCheckGridLine :: GridLine -> GridLine
partialCheckGridLine :: GridLine -> GridLine
partialCheckGridLine GridLine
gridLine = case GridLine
gridLine of
  Coordinate Integer
0                   -> Integer -> GridLine
forall {a} {a}. Show a => a -> a
errorValue Integer
0
  GridLineCustomIdent CustomIdentGrid
_ (Just Integer
0) -> Integer -> GridLine
forall {a} {a}. Show a => a -> a
errorValue Integer
0
  s :: GridLine
s@(Span Maybe CustomIdentGrid
_ (Just Integer
n))            -> if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
1
                                    then Integer -> GridLine
forall {a} {a}. Show a => a -> a
errorValue Integer
n
                                    else GridLine
s
  GridLine
_                              -> GridLine
gridLine
  where
    errorValue :: a -> a
errorValue a
n = String -> a
forall a. HasCallStack => String -> a
error (String
"Value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is invalid")

-- | Private partial function checking 'OneGridLine'.
--
-- An error is raised if an invalid value is found, see 'partialCheckGridLine'.
partialCheckOneGridLine :: OneGridLine -> OneGridLine
partialCheckOneGridLine :: OneGridLine -> OneGridLine
partialCheckOneGridLine (OneGridLine GridLine
gridLine) =
  GridLine -> OneGridLine
OneGridLine (GridLine -> GridLine
partialCheckGridLine GridLine
gridLine)

-- | Private partial function checking 'TwoGridLines'.
--
-- An error is raised if an invalid value is found, see 'partialCheckGridLine'.
partialCheckTwoGridLines :: TwoGridLines -> TwoGridLines
partialCheckTwoGridLines :: TwoGridLines -> TwoGridLines
partialCheckTwoGridLines (TwoGridLines GridLine
gridLine1 GridLine
gridLine2) =
  GridLine -> GridLine -> TwoGridLines
TwoGridLines (GridLine -> GridLine
partialCheckGridLine GridLine
gridLine1) (GridLine -> GridLine
partialCheckGridLine GridLine
gridLine2)

-- | Private partial function checking 'ThreeGridLines'.
--
-- An error is raised if an invalid value is found, see 'partialCheckGridLine'.
partialCheckThreeGridLines :: ThreeGridLines -> ThreeGridLines
partialCheckThreeGridLines :: ThreeGridLines -> ThreeGridLines
partialCheckThreeGridLines (ThreeGridLines GridLine
gridLine1 GridLine
gridLine2 GridLine
gridLine3) =
  GridLine -> GridLine -> GridLine -> ThreeGridLines
ThreeGridLines
    (GridLine -> GridLine
partialCheckGridLine GridLine
gridLine1)
    (GridLine -> GridLine
partialCheckGridLine GridLine
gridLine2)
    (GridLine -> GridLine
partialCheckGridLine GridLine
gridLine3)

-- | Private partial function checking 'FourGridLines'.
--
-- An error is raised if an invalid value is found, see 'partialCheckGridLine'.
partialCheckFourGridLines :: FourGridLines -> FourGridLines
partialCheckFourGridLines :: FourGridLines -> FourGridLines
partialCheckFourGridLines
  (FourGridLines GridLine
gridLine1 GridLine
gridLine2 GridLine
gridLine3 GridLine
gridLine4) =
    GridLine -> GridLine -> GridLine -> GridLine -> FourGridLines
FourGridLines
      (GridLine -> GridLine
partialCheckGridLine GridLine
gridLine1)
      (GridLine -> GridLine
partialCheckGridLine GridLine
gridLine2)
      (GridLine -> GridLine
partialCheckGridLine GridLine
gridLine3)
      (GridLine -> GridLine
partialCheckGridLine GridLine
gridLine4)

-- | Private partial function converting its argument to 'GridLine'.
--
-- An error is raised if an invalid value is found, see 'partialCheckGridLine'.
partialToGridLine :: ToGridLine a => a -> GridLine
partialToGridLine :: forall a. ToGridLine a => a -> GridLine
partialToGridLine = GridLine -> GridLine
partialCheckGridLine (GridLine -> GridLine) -> (a -> GridLine) -> a -> GridLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> GridLine
forall a. ToGridLine a => a -> GridLine
toGridLine

-- | Private partial function converting its argument to 'GridLines2'.
--
-- An error is raised if an invalid value is found, see 'partialCheckGridLine'.
partialToGridLines2 :: ToGridLines2 a => a -> GridLines2
partialToGridLines2 :: forall a. ToGridLines2 a => a -> GridLines2
partialToGridLines2 a
x = GridLines2 -> GridLines2
partialGridLine' GridLines2
gridLines
  where
    gridLines :: GridLines2
gridLines = a -> GridLines2
forall a. ToGridLines2 a => a -> GridLines2
toGridLines2 a
x
    partialGridLine' :: GridLines2 -> GridLines2
partialGridLine' (One2 OneGridLine
gl) = OneGridLine -> GridLines2
One2 (OneGridLine -> OneGridLine
partialCheckOneGridLine OneGridLine
gl)
    partialGridLine' (Two2 TwoGridLines
gl) = TwoGridLines -> GridLines2
Two2 (TwoGridLines -> TwoGridLines
partialCheckTwoGridLines TwoGridLines
gl)

-- | Private partial function converting its argument to 'GridLines4'.
--
-- An error is raised if an invalid value is found, see 'partialCheckGridLine'.
partialToGridLines4 :: ToGridLines4 a => a -> GridLines4
partialToGridLines4 :: forall a. ToGridLines4 a => a -> GridLines4
partialToGridLines4 a
x = GridLines4 -> GridLines4
partialGridLine' GridLines4
gridLines
  where
    gridLines :: GridLines4
gridLines = a -> GridLines4
forall a. ToGridLines4 a => a -> GridLines4
toGridLines4 a
x
    partialGridLine' :: GridLines4 -> GridLines4
partialGridLine' (One4 OneGridLine
gl)   = OneGridLine -> GridLines4
One4 (OneGridLine -> OneGridLine
partialCheckOneGridLine OneGridLine
gl)
    partialGridLine' (Two4 TwoGridLines
gl)   = TwoGridLines -> GridLines4
Two4 (TwoGridLines -> TwoGridLines
partialCheckTwoGridLines TwoGridLines
gl)
    partialGridLine' (Three4 ThreeGridLines
gl) = ThreeGridLines -> GridLines4
Three4 (ThreeGridLines -> ThreeGridLines
partialCheckThreeGridLines ThreeGridLines
gl)
    partialGridLine' (Four4 FourGridLines
gl)  = FourGridLines -> GridLines4
Four4 (FourGridLines -> FourGridLines
partialCheckFourGridLines FourGridLines
gl)

-- | Private utility function to show 'Text' instead of 'String'.
tshow :: Show a => a -> Text
tshow :: forall a. Show a => a -> Text
tshow = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show